From 89216068af910941199990aa1d8d6155e1f09bb7 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 30 Jul 2010 12:43:47 -0400
Subject: [PATCH 001/137] New support for OpenCV 2.1.

- Fixed types in foreign imports.
- Added a wrapper for cvErode.
- Moved more memory management into Haskell.
- Added reference to github fork to the .cabal file (this may be removed).
---
 HOpenCV.cabal                   | 53 ++++++++-----------
 src/AI/CV/OpenCV/CV.hsc         | 45 +++++++++++-----
 src/AI/CV/OpenCV/CxCore.hsc     | 91 ++++++++++++++++++++-------------
 src/AI/CV/OpenCV/HOpenCV_wrap.c |  6 +--
 src/AI/CV/OpenCV/HOpenCV_wrap.h |  4 +-
 src/AI/CV/OpenCV/HighGui.hs     |  6 +--
 src/AI/CV/OpenCV/Types.hs       |  7 +--
 7 files changed, 116 insertions(+), 96 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index c9697d7..5bee41d 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,35 +1,25 @@
 name: HOpenCV
-version: 0.1.2.2
+version: 0.1.2.2.1
 license: BSD3
 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
+synopsis: A binding for the OpenCV computer vision library.
+Tested-With:   GHC == 6.12.1
 description:
-   Initial version with very limited bindings to OpenCV 2.0. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
-   .
-   For a functional interface to this library, see the package "cv-combinators".
-   .
-   Online module documentation, if not build below, can be found at <http://www.ee.bgu.ac.il/~noamle/>.
+   Limited bindings to OpenCV 2.1. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently only tested on Ubuntu Linux, but should work on most linux distributions. For OpenCV installation on other *nix platforms, see <http://sourceforge.net/projects/opencvlibrary/files/opencv-unix/2.0/>
-   .
-   On /Ubuntu/ systems, the appropriate version of OpenCV can be installed by (the instructions are for Karmic):
-   .
-   > sudo add-apt-repository ppa:gijzelaar/opencv2-karmic
-   > sudo apt-get update
-   > sudo apt-get install libcv-dev libhighgui-dev
-   .
-   You should then have libcv4 and libhighgui4 installed automatically too.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04 and Mac OS 10.5 and 10.6.
    .
    
-build-type: Simple
-cabal-version:  >= 1.2
-extra-source-files:
-   src/AI/CV/OpenCV/HOpenCV_wrap.h
+build-type:         Simple
+cabal-version:      >= 1.2
+extra-source-files: src/AI/CV/OpenCV/HOpenCV_wrap.h
+source-repository head
+  type: git
+  location: git://github.com/acowley/HOpenCV.git
 
 library
    exposed-modules:
@@ -37,27 +27,26 @@ library
       AI.CV.OpenCV.CxCore
       AI.CV.OpenCV.HighGui
       AI.CV.OpenCV.Types
+      AI.CV.OpenCV.HIplImage
+      AI.CV.OpenCV.PixelUtils
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
-   include-dirs: /usr/include/opencv
-   extra-libraries: cv,highgui
-   build-depends: base >=4 && <5, allocated-processor >= 0.0.1, vector-space
+   extra-libraries: cxcore,cv,highgui
+   build-depends: base >=4 && <5, 
+                  allocated-processor >= 0.0.1, 
+                  vector-space,
+                  vector >= 0.6.0.2 && < 0.7
    ghc-options: -Wall -fno-warn-type-defaults
 
 executable test-hopencv
   c-sources:
      src/AI/CV/OpenCV/HOpenCV_wrap.c
-  include-dirs: /usr/include/opencv
   hs-source-dirs:  src
   Build-Depends: base >=4 && <5
   main-is: Test.hs
   Ghc-Options: -Wall -fno-warn-type-defaults
   Ghc-Prof-Options:  -prof -auto-all 
-  extra-libraries: cv,highgui
-  other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, AI.CV.OpenCV.Types
-
-
---source-repository head
---  type: git
---  location: git://github.com/sinelaw/HOpenCV.git
+  extra-libraries: cxcore,cv,highgui
+  other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, 
+                 AI.CV.OpenCV.Types
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index db58062..9649717 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -1,24 +1,30 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
-
-module AI.CV.OpenCV.CV where
+-- |Support for features from the OpenCV Image Filtering library.
+module AI.CV.OpenCV.CV 
+    ( InterpolationMethod(..),
+      cvCanny, cvResize, cvDilate, cvErode, cvPyrDown,
+      CvHaarClassifierCascade, HaarDetectFlag,
+      cvHaarFlagNone, cvHaarDoCannyPruning, 
+      cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
+      combineHaarFlags, cvHaarDetectObjects
+    ) where
 
 import Foreign.C.Types
 import Foreign.Ptr
- 
 import Data.Bits
-
 import AI.CV.OpenCV.CxCore
 
-#include <cv.h>
+#include <opencv/cv.h>
 
-
-foreign import ccall unsafe "cv.h cvCanny"
+foreign import ccall unsafe "opencv/cv.h cvCanny"
   c_cvCanny :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> IO ()
 
+-- Canny 
 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 (fromArr src) (fromArr dst) (realToFrac threshold1) 
+            (realToFrac threshold2) apertureSize
 
 
 data InterpolationMethod = CV_INTER_NN 
@@ -27,20 +33,31 @@ data InterpolationMethod = CV_INTER_NN
                          | CV_INTER_AREA
                            deriving (Enum,Eq)
 
-foreign import ccall unsafe "cv.h cvResize"
+foreign import ccall unsafe "opencv/cv.h cvResize"
   c_cvResize :: Ptr CvArr -> Ptr CvArr -> 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)
 
-foreign import ccall unsafe "HOpenCV_warp.h dilate"
-  c_dilate :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
+foreign import ccall unsafe "opencv/cv.h cvDilate"
+  c_dilate :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
+-- |Dilate the first image using a 3x3 rectangular structuring element
+-- and store the result in the second image. The third parameter is
+-- the number of dilation iterations to perform.
 cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2  -> CInt -> IO ()
-cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) iter
+cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) nullPtr iter
+
+foreign import ccall unsafe "opencv/cv.h cvErode"
+  c_erode :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
+-- |Erode the first image using a 3x3 rectangular structuring element
+-- and store the result in the second image. The third parameter is
+-- the number of erosion iterations to perform.
+cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
+cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
 
-foreign import ccall unsafe "cv.h cvPyrDown"
+foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 -- for now only one filter type is supported so no need for the CInt (filter type)
@@ -68,7 +85,7 @@ newtype HaarDetectFlag = HaarDetectFlag { unHaarDetectFlag :: CInt }
 combineHaarFlags :: [HaarDetectFlag] -> HaarDetectFlag
 combineHaarFlags = HaarDetectFlag . foldr ((.|.) . unHaarDetectFlag) 0
   
-foreign import ccall unsafe "HOpenCV_warp.h c_cvHaarDetectObjects"
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvHaarDetectObjects"
   c_cvHaarDetectObjects :: Ptr CvArr   -- ^ image
                         -> Ptr CvHaarClassifierCascade -- ^ cascade
                         -> Ptr CvMemStorage            -- ^ storage
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index 94a3456..2f42ff3 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -1,21 +1,25 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
 
 module AI.CV.OpenCV.CxCore where
-
-import Foreign.ForeignPtrWrap
 import Foreign.C.Types
 import Foreign.C.String
-import Foreign
+import Foreign.ForeignPtr
+import Foreign.ForeignPtrWrap
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import System.IO.Unsafe (unsafePerformIO)
 
 import Data.VectorSpace as VectorSpace
 
-#include <cxcore.h>
+#include <opencv/cxcore.h>
 
 ------------------------------------------------------
 toFromIntegral :: (RealFrac c, Integral b, Integral a, Num b1) => (b1 -> c) -> a -> b
 toFromIntegral f = round . f . fromIntegral
 
-toFromIntegral2 :: (Integral a, Num b, Integral a1, Num b1, RealFrac a2, Integral b2) => (b -> b1 -> a2) -> a -> a1 -> b2
+toFromIntegral2 :: (Integral a, Num b, Integral a1, Num b1, RealFrac a2, Integral b2) => 
+                   (b -> b1 -> a2) -> a -> a1 -> b2
 toFromIntegral2 f x y = round (f (fromIntegral x) (fromIntegral y))
 ------------------------------------------------------
 
@@ -49,7 +53,6 @@ instance VectorSpace CvSize where
   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)
                         
@@ -67,7 +70,6 @@ instance Storable CvRect where
         (#poke CvRect, y) ptr y
         (#poke CvRect, width) ptr w
         (#poke CvRect, height) ptr h
-        
 
 liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect
 liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h)
@@ -85,8 +87,6 @@ instance AdditiveGroup CvRect where
 instance VectorSpace CvRect where
   type Scalar CvRect = Double -- todo: use CInt instead of Double here?
   a *^ r = liftCvRect (a*) r
-  
-
 
 ------------------------------------------------------
 class IplArrayType a
@@ -119,7 +119,8 @@ newtype Depth = Depth { unDepth :: CInt }
 }               
 
 validDepths :: [Depth]
-validDepths = [iplDepth1u, iplDepth8u, iplDepth8s, iplDepth16u, iplDepth16s, iplDepth32s, iplDepth32f, iplDepth64f]
+validDepths = [iplDepth1u, iplDepth8u, iplDepth8s, iplDepth16u, 
+               iplDepth16s, iplDepth32s, iplDepth32f, iplDepth64f]
 
 depthsLookupList :: [(CInt, Depth)]
 depthsLookupList = map (\d -> (unDepth d, d)) validDepths
@@ -130,40 +131,59 @@ numToDepth x = lookup x depthsLookupList
 
 ---------------------------------------------------------------
 -- mem storage
-foreign import ccall unsafe "cxcore.h cvCreateMemStorage"
+foreign import ccall unsafe "opencv/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 "HOpenCV_warp.h release_mem_storage"
-  cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
+-- foreign import ccall unsafe "HOpenCV_wrap.h release_mem_storage"
+--   cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
 
-foreign import ccall unsafe "HOpenCV_warp.h &release_mem_storage"
+foreign import ccall unsafe "opencv/cxcore.h cvReleaseMemStorage"
+  c_cvReleaseMemStorage :: Ptr (Ptr CvMemStorage) -> IO ()
+
+cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
+cvReleaseMemStorage mem = 
+    do fp <- mallocForeignPtr
+       withForeignPtr fp (\p -> do poke p mem >> c_cvReleaseMemStorage p)
+
+foreign import ccall unsafe "HOpenCV_wrap.h &release_mem_storage"
   cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ())
 
 createMemStorageF :: CInt -> IO (ForeignPtr CvMemStorage)
 createMemStorageF = (createForeignPtr cp_release_mem_storage) . cvCreateMemStorage
-  
 
 -- images / matrices / arrays
 
-foreign import ccall unsafe "HOpenCV_warp.h create_image"
+foreign import ccall unsafe "HOpenCV_wrap.h create_image"
   c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage)
 
+-- |Allocate memory for an 'IplImage' with the given dimensions,
+-- number of color channels, and color depth.
 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_warp.h release_image"
-  cvReleaseImage :: Ptr IplImage -> IO ()
-
-foreign import ccall unsafe "HOpenCV_warp.h &release_image"
+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 release_image"
+--   cvReleaseImage :: Ptr IplImage -> IO ()
+foreign import ccall unsafe "opencv/cxcore.h cvReleaseImage"
+  c_cvReleaseImage :: Ptr (Ptr IplImage) -> IO ()
+
+-- |Release the memory allocated to an 'IplImage'.
+cvReleaseImage :: Ptr IplImage -> IO ()
+cvReleaseImage mem = 
+    do fp <- mallocForeignPtr
+       withForeignPtr fp (\p -> poke p mem >> c_cvReleaseImage p)
+
+foreign import ccall unsafe "HOpenCV_wrap.h &release_image"
   cp_release_image :: FunPtr (Ptr IplImage -> IO ())
 
 createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage)
 createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z
 
-foreign import ccall unsafe "cxcore.h cvCloneImage"
+foreign import ccall unsafe "opencv/cxcore.h cvCloneImage"
   c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
 
 cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
@@ -172,10 +192,10 @@ cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage
 cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage)
 cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x
   
-foreign import ccall unsafe "HOpenCV_warp.h get_size"
+foreign import ccall unsafe "HOpenCV_wrap.h get_size"
   c_get_size :: Ptr CvArr -> Ptr CvSize -> IO ()
 
-foreign import ccall unsafe "cxcore.h cvCopy"
+foreign import ccall unsafe "opencv/cxcore.h cvCopy"
   c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
                    
 -- todo add mask support
@@ -189,7 +209,7 @@ cvGetSize p = unsafePerformIO $
                 size <- peek cvSizePtr
                 return size
 
-foreign import ccall unsafe "HOpenCV_warp.h get_depth"
+foreign import ccall unsafe "HOpenCV_wrap.h get_depth"
   c_get_depth :: Ptr IplImage -> IO CInt
 
 getDepth :: Ptr IplImage -> IO Depth
@@ -199,21 +219,20 @@ getDepth img = do
     Nothing -> fail "Bad depth in image struct"
     Just depth -> return depth
 
-foreign import ccall unsafe "HOpenCV_warp.h get_nChannels"
+foreign import ccall unsafe "HOpenCV_wrap.h get_nChannels"
   c_get_nChannels :: Ptr IplImage -> IO CInt
 
 getNumChannels :: Integral a => Ptr IplImage -> IO a
 getNumChannels img = fmap fromIntegral $ c_get_nChannels img
 
 
-foreign import ccall unsafe "cxcore.h cvConvertScale"
+foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
   cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
-
                                 
-foreign import ccall unsafe "HOpenCV_warp.h cv_free"
+foreign import ccall unsafe "HOpenCV_wrap.h cv_free"
   cvFree :: Ptr a -> IO ()
             
-foreign import ccall unsafe "cxcore.h cvLoad"
+foreign import ccall unsafe "opencv/cxcore.h cvLoad"
   c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a)
 
 cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String)
@@ -231,13 +250,13 @@ cvLoad filename memstorage name = withCString filename cvLoad'
               cvFree realNameC
               return (ptrObj, realName)
               
-foreign import ccall unsafe "cxcore.h cvGetSeqElem"
+foreign import ccall unsafe "opencv/cxcore.h cvGetSeqElem"
   cvGetSeqElem :: Ptr (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"
+foreign import ccall unsafe "HOpenCV_wrap.h seq_total"
   seqNumElems :: Ptr (CvSeq a) -> IO CInt
 
 seqToPList :: Ptr (CvSeq a) -> IO [Ptr a]
@@ -261,7 +280,7 @@ seqToList pseq = do
 --     rect <- peek rectP
 --     return rect
 
-foreign import ccall unsafe "HOpenCV_warp.h c_cvRectangle"
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvRectangle"
   c_cvRectangle :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> IO ()
 
 cvRectangle :: IplArrayType a => Ptr a -> CvRect -> IO ()
@@ -271,5 +290,5 @@ cvRectangle dst (CvRect x y w h) = c_cvRectangle (fromArr dst) 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"
+foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header"
   c_debug_print_image_header :: Ptr IplImage -> IO ()
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c
index 6ae3121..727c912 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c
@@ -1,6 +1,6 @@
-#include <cxcore.h>
-#include <cv.h>
-#include <highgui.h>
+#include <opencv/cxcore.h>
+#include <opencv/cv.h>
+#include <opencv/highgui.h>
 
 #include <stdio.h>
 
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/HOpenCV_wrap.h
index 913b929..81f9844 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.h
@@ -1,5 +1,5 @@
-#include <cv.h>
-#include <cxcore.h>
+#include <opencv/cv.h>
+#include <opencv/cxcore.h>
 
 void debug_print_image_header(IplImage *image);
 
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index e5ff616..126cca5 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -39,10 +39,10 @@ cvCreateFileCapture filename = err' . checkPtr $ withCString filename f
           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"
+  release_capture  :: Ptr CvCapture -> IO ()
 
-foreign import ccall unsafe "HOpenCV_warp.h &release_capture"
+foreign import ccall unsafe "HOpenCV_wrap.h &release_capture"
   cp_release_capture  :: FunPtr (Ptr CvCapture -> IO () )
  
 createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture)
diff --git a/src/AI/CV/OpenCV/Types.hs b/src/AI/CV/OpenCV/Types.hs
index dd84a2d..ca94f2e 100644
--- a/src/AI/CV/OpenCV/Types.hs
+++ b/src/AI/CV/OpenCV/Types.hs
@@ -1,14 +1,9 @@
 module AI.CV.OpenCV.Types where
-
-
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.HighGui
-
-import Foreign
+import Foreign.Ptr
 import Foreign.ForeignPtr
 
-
-
 type PImage = Ptr IplImage
 type PCapture = Ptr CvCapture
 

From 03b7ec3299e870d72624afde9b9fd1500fb64179 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 30 Jul 2010 12:45:49 -0400
Subject: [PATCH 002/137] Added a Haskell data type that wraps up IplImage.

The HIplImage data type includes the features from the IplImage struct
that OpenCV makes use of. This simplifies the job of inspecting an
IplImage obtained from OpenCV for further processing in Haskell.

Added the PixelUtils module for working with OpenCV's image packing
style. The primary issue is that the image data buffer in an IplImage
will sometimes contain room for four color channels even if only three
are used. This is good for considering an image on a row-by-row basis,
but complicates the view of image data as a single vector.
---
 src/AI/CV/OpenCV/HIplImage.hsc | 119 +++++++++++++++++++++++++++++++++
 src/AI/CV/OpenCV/PixelUtils.hs |  82 +++++++++++++++++++++++
 2 files changed, 201 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/HIplImage.hsc
 create mode 100644 src/AI/CV/OpenCV/PixelUtils.hs

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
new file mode 100644
index 0000000..3f190ca
--- /dev/null
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -0,0 +1,119 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module AI.CV.OpenCV.HIplImage where
+import AI.CV.OpenCV.CxCore (IplImage)
+import qualified Data.Vector.Storable as V
+import Data.Word (Word8, Word16)
+import Foreign.C.Types
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Storable
+import System.IO.Unsafe
+
+#include <opencv/cxtypes.h>
+{-
+typedef struct _IplImage
+{
+    int  nSize;
+    int  ID;
+    int  nChannels;
+    int  alphaChannel;
+    int  depth;
+    char colorModel[4];
+    char channelSeq[4];
+    int  dataOrder;
+    int  origin;
+    int  align;
+    int  width;
+    int  height;
+    struct _IplROI *roi;
+    struct _IplImage *maskROI;
+    void  *imageId;
+    struct _IplTileInfo *tileInfo;
+    int  imageSize;
+    char *imageData;
+    int  widthStep;
+    int  BorderMode[4];
+    int  BorderConst[4];
+    char *imageDataOrigin;
+}
+IplImage;
+-}
+
+-- |A Haskell data structure representing the information OpenCV uses
+-- from an 'IplImage' struct.
+data HIplImage = HIplImage { nSize           :: Int
+                           , nChannels       :: Int
+                           , depth           :: Int
+                           , dataOrder       :: Int
+                           , origin          :: Int
+                           , width           :: Int
+                           , height          :: Int
+--                         , roi             :: Ptr ()
+                           , imageSize       :: Int 
+                           , imageData       :: Ptr Word8
+                           , widthStep       :: Int
+                           , imageDataOrigin :: Ptr Word8 }
+
+-- |Return a 'V.Vector' containing the pixels that make up the
+-- 8-bit-per-pixel 'HIplImage'.
+pixels :: HIplImage -> V.Vector Word8
+pixels img = V.unsafeFromForeignPtr fptr 0 (imageSize img)
+    where fptr = unsafePerformIO $ newForeignPtr_ ptr
+          ptr = case depth img of
+                  8 -> imageData img
+                  x -> error $ "Pixel depth must be 8, "++show x++
+                               " is not supported"
+
+-- |Return a 'V.Vector' containing the pixels that make up the
+-- 16-bit-per-pixel 'HIplImage'.
+pixels16 :: HIplImage -> V.Vector Word16
+pixels16 img = V.unsafeFromForeignPtr fptr 0 (imageSize img)
+    where fptr = unsafePerformIO $ newForeignPtr_ ptr
+          ptr = case depth img of
+                  16 -> castPtr (imageData img) :: Ptr Word16
+                  x -> error $ "Pixel depth must be 16, "++show x++
+                               " is not supported"
+
+-- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
+fromPtr :: Ptr IplImage -> IO HIplImage
+fromPtr = peek . castPtr
+
+instance Storable HIplImage where
+    sizeOf _ = (#size IplImage)
+    alignment _ = alignment (undefined :: CDouble)
+    poke ptr himg = do
+      (#poke IplImage, nSize) ptr (nSize himg)
+      (#poke IplImage, ID) ptr (0::Int)
+      (#poke IplImage, nChannels) ptr (nChannels himg)
+      (#poke IplImage, depth) ptr (depth himg)
+      (#poke IplImage, dataOrder) ptr (dataOrder himg)
+      (#poke IplImage, origin) ptr (origin himg)
+      (#poke IplImage, width) ptr (width himg)
+      (#poke IplImage, height) ptr (height himg)
+      (#poke IplImage, roi) ptr nullPtr
+      (#poke IplImage, maskROI) ptr nullPtr
+      (#poke IplImage, imageId) ptr nullPtr
+      (#poke IplImage, tileInfo) ptr nullPtr
+      (#poke IplImage, imageSize) ptr (imageSize himg)
+      (#poke IplImage, imageData) ptr (imageData himg)
+      (#poke IplImage, widthStep) ptr (widthStep himg)
+      (#poke IplImage, imageDataOrigin) ptr (imageDataOrigin himg)
+    peek ptr = do
+      nSize' <- (#peek IplImage, nSize) ptr
+      nChannels' <- (#peek IplImage, nChannels) ptr
+      depth' <- (#peek IplImage, depth) ptr
+      dataOrder' <- (#peek IplImage, dataOrder) ptr
+      origin' <- (#peek IplImage, origin) ptr
+      width' <- (#peek IplImage, width) ptr
+      height' <- (#peek IplImage, height) ptr
+      imageSize' <- (#peek IplImage, imageSize) ptr
+      imageData' <- (#peek IplImage, imageData) ptr
+      widthStep' <- (#peek IplImage, widthStep) ptr
+      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr
+      return $ HIplImage nSize' nChannels' depth' dataOrder' origin' 
+                         width' height' imageSize' imageData' widthStep' 
+                         imageDataOrigin'
+
+
+
+                    
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
new file mode 100644
index 0000000..07d2a11
--- /dev/null
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE BangPatterns #-}
+-- |Images obtained from OpenCV usually have the components of color
+-- pixels arranged in BGR order and pad image rows with unused
+-- bytes. This module provides mechanisms to re-order pixels to RGB
+-- and to drop the unused packing bytes.
+module AI.CV.OpenCV.PixelUtils where
+import AI.CV.OpenCV.HIplImage
+import Control.Monad.ST (runST)
+import Data.Word (Word8)
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as VM
+import qualified Data.Vector.Generic as VG
+
+-- |Generate indices to convert OpenCV-native BGR pixel ordering to
+-- RGB and drop unused packing bytes from each row. The returned index
+-- 'V.Vector' may be passed to 'toRGB'' to speed up pixel ordering
+-- conversion when multiple conversions are to be performed.
+rgbIndices :: Int -> Int -> Int -> V.Vector Int
+rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
+    where rowStarts = [0,stride..numElems-1]
+          row s = concatMap (\c -> map (s + c*3 +) [2,1,0]) [0..width'-1]
+
+-- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded rows
+-- to tightly packed rows of RGB pixels.
+toRGB :: HIplImage -> V.Vector Word8
+toRGB img = V.backpermute (pixels img) $
+            rgbIndices (width img) (widthStep img) (imageSize img)
+
+-- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded
+-- rows to tightly packed rows of RGB pixels using the given
+-- 'V.Vector' of indices. The index 'Vector' will typically be the
+-- result of a previous call to 'rgbIndices'.
+toRGB' :: HIplImage -> V.Vector Int -> V.Vector Word8
+toRGB' img inds = V.backpermute (pixels img) inds
+
+-- |Drop any pixels beyond real image data on each row.
+dropAlpha :: V.Storable a => Int -> V.Vector a -> V.Vector a
+dropAlpha w = V.ifilter (\i _ -> (i `rem` rowLength) < realWidth)
+    where rowLength = w * 4
+          realWidth = w * 3
+
+-- |Return a Vector of bytes of a single color channel from a
+-- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
+isolateChannel :: Int -> HIplImage -> V.Vector Word8
+isolateChannel ch img = 
+    if ch >= 3 || numCh /= 3
+    then error $ "Invalid channel "++show ch++" for image with "++show numCh++
+                 " color channels"
+    else runST $ do v <- VM.new (w*h)
+                    let go !x !p !p3 !y
+                            | y >= h = VG.unsafeFreeze v
+                            | x == w = go 0 p (p3+margin) (y+1)
+                            | otherwise = do VM.unsafeWrite v p (get p3)
+                                             go (x+1) (p+1) (p3+3) y
+                    go 0 0 ch 0
+    where numCh = nChannels img
+          w = width img
+          h = height img
+          margin = widthStep img - (w  * 3)
+          pix = pixels img
+          get = V.unsafeIndex pix
+
+-- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
+toMono :: HIplImage -> V.Vector Word8
+toMono img = if nChannels img == 1 then dropAlpha w pix 
+             else runST $ do v <- VM.new (w*h)
+                             let go !x !p !p3 !y
+                                     | y >= h = VG.unsafeFreeze v
+                                     | x == w = go 0 p (p3+margin) (y+1)
+                                     | otherwise = let grey = getAvg p3
+                                                   in do VM.unsafeWrite v p grey
+                                                         go (x+1) (p+1) (p3+3) y
+                             go 0 0 0 0
+    where w = width img
+          h = height img
+          margin = widthStep img - (w * 3)
+          pix = pixels img
+          get :: Int -> Int
+          get = fromIntegral . V.unsafeIndex pix
+          getAvg i = avg (get i) (get (i+1)) (get (i+2))
+          avg :: Int -> Int -> Int -> Word8
+          avg b g r = fromIntegral $ (b + g + r) `div` 3

From b33b18b4b5dd04ff2b549017014a4f50564f68b0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 30 Jul 2010 18:52:43 -0400
Subject: [PATCH 003/137] Improved ease of use HIplImage as a gateway to OpenCV
 operations.

- Added an HIplImage smart constructor from image dimensions and a
  vector of pixel data.

- Added a functional inteface for OpenCV dilation and erosion on
  HIplImage values.
---
 HOpenCV.cabal                  |   3 +-
 src/AI/CV/OpenCV/CV.hsc        |  15 +++-
 src/AI/CV/OpenCV/CxCore.hsc    |   8 +-
 src/AI/CV/OpenCV/HIplImage.hsc | 137 ++++++++++++++++++++++++++++-----
 src/AI/CV/OpenCV/PixelUtils.hs |   1 +
 5 files changed, 136 insertions(+), 28 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 5bee41d..bf5f28e 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -29,6 +29,7 @@ library
       AI.CV.OpenCV.Types
       AI.CV.OpenCV.HIplImage
       AI.CV.OpenCV.PixelUtils
+      AI.CV.OpenCV.ColorConversion
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
@@ -49,4 +50,4 @@ executable test-hopencv
   Ghc-Prof-Options:  -prof -auto-all 
   extra-libraries: cxcore,cv,highgui
   other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, 
-                 AI.CV.OpenCV.Types
+                 AI.CV.OpenCV.Types AI.CV.OpenCV.ColorConversion
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index 9649717..0a8c07e 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -6,13 +6,15 @@ module AI.CV.OpenCV.CV
       CvHaarClassifierCascade, HaarDetectFlag,
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
-      combineHaarFlags, cvHaarDetectObjects
+      combineHaarFlags, cvHaarDetectObjects,
+      cvCvtColor
     ) where
 
 import Foreign.C.Types
 import Foreign.Ptr
 import Data.Bits
 import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.ColorConversion
 
 #include <opencv/cv.h>
 
@@ -57,6 +59,17 @@ foreign import ccall unsafe "opencv/cv.h cvErode"
 cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
 cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
 
+foreign import ccall unsafe "opencv/cv.h cvCvtColor"
+  c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
+
+-- |Convert the color of the first 'IplImage', storing the result in
+-- the second. The second image must have the same dimensions as the
+-- first and the same depth, but it's number of color channels may be
+-- different and must be compatible with the given 'ColorConversion'
+-- code.
+cvCvtColor :: Ptr CvArr -> Ptr CvArr -> ColorConversion -> IO ()
+cvCvtColor src dst code = c_cvCvtColor src dst (colorConv code)
+
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index 2f42ff3..ad69704 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -144,9 +144,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvReleaseMemStorage"
   c_cvReleaseMemStorage :: Ptr (Ptr CvMemStorage) -> IO ()
 
 cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
-cvReleaseMemStorage mem = 
-    do fp <- mallocForeignPtr
-       withForeignPtr fp (\p -> do poke p mem >> c_cvReleaseMemStorage p)
+cvReleaseMemStorage mem = alloca $ \p -> poke p mem >> c_cvReleaseMemStorage p
 
 foreign import ccall unsafe "HOpenCV_wrap.h &release_mem_storage"
   cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ())
@@ -173,9 +171,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvReleaseImage"
 
 -- |Release the memory allocated to an 'IplImage'.
 cvReleaseImage :: Ptr IplImage -> IO ()
-cvReleaseImage mem = 
-    do fp <- mallocForeignPtr
-       withForeignPtr fp (\p -> poke p mem >> c_cvReleaseImage p)
+cvReleaseImage mem = alloca $ \p -> poke p mem >> c_cvReleaseImage p
 
 foreign import ccall unsafe "HOpenCV_wrap.h &release_image"
   cp_release_image :: FunPtr (Ptr IplImage -> IO ())
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 3f190ca..a11ecb8 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,10 +1,14 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.HIplImage where
-import AI.CV.OpenCV.CxCore (IplImage)
+import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
+import AI.CV.OpenCV.CV (cvErode, cvDilate)
+import Control.Applicative ((<$>))
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc (alloca, finalizerFree)
+import Foreign.Marshal.Array (mallocArray, copyArray)
 import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe
@@ -43,34 +47,47 @@ IplImage;
 -- from an 'IplImage' struct.
 data HIplImage = HIplImage { nSize           :: Int
                            , nChannels       :: Int
-                           , depth           :: Int
+                           , depth           :: Depth
                            , dataOrder       :: Int
                            , origin          :: Int
                            , width           :: Int
                            , height          :: Int
 --                         , roi             :: Ptr ()
                            , imageSize       :: Int 
-                           , imageData       :: Ptr Word8
+                           , imageData       :: ForeignPtr Word8
                            , widthStep       :: Int
-                           , imageDataOrigin :: Ptr Word8 }
+                           , imageDataOrigin :: ForeignPtr Word8 }
 
--- |Return a 'V.Vector' containing the pixels that make up the
--- 8-bit-per-pixel 'HIplImage'.
+-- |Return a 'V.Vector' containing a copy of the pixels that make up
+-- the 8-bit-per-pixel 'HIplImage'.
+pixelsCopy :: HIplImage -> IO (V.Vector Word8)
+pixelsCopy img = do dst <- mallocArray sz
+                    withForeignPtr src $ \src' -> copyArray dst src' sz
+                    fptr <- newForeignPtr finalizerFree dst
+                    return $ V.unsafeFromForeignPtr fptr 0 sz
+    where sz = imageSize img
+          src = case depth img of
+                  Depth 8 -> imageData img
+                  x -> error $ "Pixel depth must be 8, "++show x++
+                               " is not supported"
+
+-- |Return a 'V.Vector' containing the pixels that make up an
+-- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
+-- data!
 pixels :: HIplImage -> V.Vector Word8
-pixels img = V.unsafeFromForeignPtr fptr 0 (imageSize img)
-    where fptr = unsafePerformIO $ newForeignPtr_ ptr
-          ptr = case depth img of
-                  8 -> imageData img
+pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
+    where ptr = case depth img of
+                  Depth 8 -> imageData img
                   x -> error $ "Pixel depth must be 8, "++show x++
                                " is not supported"
 
+
 -- |Return a 'V.Vector' containing the pixels that make up the
 -- 16-bit-per-pixel 'HIplImage'.
 pixels16 :: HIplImage -> V.Vector Word16
-pixels16 img = V.unsafeFromForeignPtr fptr 0 (imageSize img)
-    where fptr = unsafePerformIO $ newForeignPtr_ ptr
-          ptr = case depth img of
-                  16 -> castPtr (imageData img) :: Ptr Word16
+pixels16 img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
+    where ptr = case depth img of
+                  Depth 16 -> castForeignPtr (imageData img)
                   x -> error $ "Pixel depth must be 16, "++show x++
                                " is not supported"
 
@@ -78,6 +95,85 @@ pixels16 img = V.unsafeFromForeignPtr fptr 0 (imageSize img)
 fromPtr :: Ptr IplImage -> IO HIplImage
 fromPtr = peek . castPtr
 
+-- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
+-- and number of color channels with an allocated pixel buffer.
+mkHIplImage :: Int -> Int -> Int -> IO HIplImage
+mkHIplImage w h numChan = do buffer <- mallocArray numBytes
+                             ptr <- newForeignPtr finalizerFree buffer
+                             return $ HIplImage (#size IplImage)
+                                                numChan
+                                                iplDepth8u 0 0 w h
+                                                numBytes
+                                                ptr
+                                                (w*numChan)
+                                                ptr
+    where numBytes = w * h * numChan
+
+-- |Allocate a new 'HIplImage' with the same dimensions, number of
+-- color channels, and color depth as an existing HIplImage. The pixel
+-- data of the original 'HIplImage' is not copied.
+compatibleImage :: HIplImage -> IO HIplImage
+compatibleImage img = 
+    do ptr <- newForeignPtr finalizerFree =<< mallocArray sz
+       return $ HIplImage (#size IplImage) nc d 0 0 w h sz ptr stride ptr
+    where w = width img
+          h = height img
+          nc = nChannels img
+          d = depth img
+          sz = imageSize img
+          stride = widthStep img
+
+-- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
+-- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
+-- with the supplied 'V.Vector'.
+fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage
+fromPixels w h pix = unsafePerformIO $ 
+                     V.unsafeWith pix $
+                         \p -> do fp <- newForeignPtr_ p
+                                  return $ HIplImage (#size IplImage) nc 
+                                                     iplDepth8u 0 0 w' h'
+                                                     sz fp stride fp
+    where sz = V.length pix
+          nc = if sz == w'*h' then 1 else 3
+          stride = w' * nc
+          w' = fromIntegral w
+          h' = fromIntegral h
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying the given 'HIplImage'.
+withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
+withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
+
+-- |Erode an 'HIplImage' with a 3x3 structuring element for the
+-- specified number of iterations.
+erode :: HIplImage -> Int -> HIplImage
+erode img n = unsafePerformIO $ 
+              do destImg <- compatibleImage img
+                 withHIplImage img (\src -> withHIplImage destImg $
+                                            \dst -> cvErode src dst n')
+                 return destImg
+    where n' = fromIntegral n
+
+-- |Dilate an 'HIplImage' with a 3x3 structuring element for the
+-- specified number of iterations.
+dilate :: HIplImage -> Int -> HIplImage
+dilate img n = unsafePerformIO $ 
+               do destImg <- compatibleImage img
+                  withHIplImage img (\src -> withHIplImage destImg $
+                                             \dst -> cvDilate src dst n')
+                  return destImg
+    where n' = fromIntegral n
+
+-- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
+-- structure type. They share the same binary representation through
+-- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
+-- between pointers of the two types. Note that obtaining an
+-- 'HIplImage' from an 'IplImage' via 'peek' will not install a
+-- Haskell finalizer on the underlying pixel data. That data is the
+-- responsibility of the provider of the 'IplImage'. 'HIplImage'
+-- values constructed within the Haskell runtime, on the other hand,
+-- do have their underlying pixel data buffers registered with a
+-- finalizer.
 instance Storable HIplImage where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
@@ -85,7 +181,7 @@ instance Storable HIplImage where
       (#poke IplImage, nSize) ptr (nSize himg)
       (#poke IplImage, ID) ptr (0::Int)
       (#poke IplImage, nChannels) ptr (nChannels himg)
-      (#poke IplImage, depth) ptr (depth himg)
+      (#poke IplImage, depth) ptr (unDepth (depth himg))
       (#poke IplImage, dataOrder) ptr (dataOrder himg)
       (#poke IplImage, origin) ptr (origin himg)
       (#poke IplImage, width) ptr (width himg)
@@ -95,21 +191,22 @@ instance Storable HIplImage where
       (#poke IplImage, imageId) ptr nullPtr
       (#poke IplImage, tileInfo) ptr nullPtr
       (#poke IplImage, imageSize) ptr (imageSize himg)
-      (#poke IplImage, imageData) ptr (imageData himg)
+      withForeignPtr (imageData himg) $ \p -> (#poke IplImage, imageData) ptr p
       (#poke IplImage, widthStep) ptr (widthStep himg)
-      (#poke IplImage, imageDataOrigin) ptr (imageDataOrigin himg)
+      withForeignPtr (imageDataOrigin himg) $ 
+         \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
       nSize' <- (#peek IplImage, nSize) ptr
       nChannels' <- (#peek IplImage, nChannels) ptr
-      depth' <- (#peek IplImage, depth) ptr
+      depth' <- Depth <$> (#peek IplImage, depth) ptr
       dataOrder' <- (#peek IplImage, dataOrder) ptr
       origin' <- (#peek IplImage, origin) ptr
       width' <- (#peek IplImage, width) ptr
       height' <- (#peek IplImage, height) ptr
       imageSize' <- (#peek IplImage, imageSize) ptr
-      imageData' <- (#peek IplImage, imageData) ptr
+      imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
       widthStep' <- (#peek IplImage, widthStep) ptr
-      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr
+      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
       return $ HIplImage nSize' nChannels' depth' dataOrder' origin' 
                          width' height' imageSize' imageData' widthStep' 
                          imageDataOrigin'
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 07d2a11..847be1c 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -80,3 +80,4 @@ toMono img = if nChannels img == 1 then dropAlpha w pix
           getAvg i = avg (get i) (get (i+1)) (get (i+2))
           avg :: Int -> Int -> Int -> Word8
           avg b g r = fromIntegral $ (b + g + r) `div` 3
+

From 7090e4c0cf47e43708f29967baa988ae2606e3c7 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Mon, 2 Aug 2010 12:35:58 -0400
Subject: [PATCH 004/137] Added a script for generating the color conversion
 hsc2hs enum macro.

---
 src/Util/ColorConvEnum.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)
 create mode 100644 src/Util/ColorConvEnum.hs

diff --git a/src/Util/ColorConvEnum.hs b/src/Util/ColorConvEnum.hs
new file mode 100644
index 0000000..66cf244
--- /dev/null
+++ b/src/Util/ColorConvEnum.hs
@@ -0,0 +1,19 @@
+-- A simple script for generating hsc2hs #enum syntax from a series of
+-- C #define statements. Copy the relevant #define lines into the file
+-- cconv.txt, then run this script which will output the hsc2hs macro
+-- syntax to cconv.hsc.
+import Control.Applicative ((<$>))
+import Data.List (intercalate)
+import Data.Maybe (mapMaybe)
+import Text.Regex.PCRE
+
+convertLine :: String -> Maybe String
+convertLine ln = listToMaybe . mrSubList $ ln =~ "^#define\\s+CV_(\\w+)\\s+.*$"
+    where listToMaybe [] = Nothing
+          listToMaybe [x] = Just $ "  , cv_"++x++" = CV_"++x
+          listToMaybe _ = error "Unexpected match result"
+
+main = do lines' <- mapMaybe convertLine . lines <$> readFile "cconv.txt"
+          let hsc = "#{enum ColorConversion, ColorConversion" : lines' ++
+                    ["  }",""]
+          writeFile "cconv.hsc" $ intercalate "\n" hsc

From 5baa9aee8d9ff4125dbb0bc765bf23efcc80dffa Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 2 Aug 2010 18:48:36 -0400
Subject: [PATCH 005/137] Removed the nSize filed of HIplImage and renamed
 nChannels to numChannels.

These changes are to improve usability of HIplImage in a pure Haskell
context. The nSize field, in parcticular, is a constant that is of no
interest from within Haskell.
---
 src/AI/CV/OpenCV/HIplImage.hsc | 42 ++++++++--------------------------
 src/AI/CV/OpenCV/PixelUtils.hs |  4 ++--
 2 files changed, 11 insertions(+), 35 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index a11ecb8..b7fe07a 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -45,8 +45,7 @@ IplImage;
 
 -- |A Haskell data structure representing the information OpenCV uses
 -- from an 'IplImage' struct.
-data HIplImage = HIplImage { nSize           :: Int
-                           , nChannels       :: Int
+data HIplImage = HIplImage { numChannels       :: Int
                            , depth           :: Depth
                            , dataOrder       :: Int
                            , origin          :: Int
@@ -100,8 +99,7 @@ fromPtr = peek . castPtr
 mkHIplImage :: Int -> Int -> Int -> IO HIplImage
 mkHIplImage w h numChan = do buffer <- mallocArray numBytes
                              ptr <- newForeignPtr finalizerFree buffer
-                             return $ HIplImage (#size IplImage)
-                                                numChan
+                             return $ HIplImage numChan
                                                 iplDepth8u 0 0 w h
                                                 numBytes
                                                 ptr
@@ -115,10 +113,10 @@ mkHIplImage w h numChan = do buffer <- mallocArray numBytes
 compatibleImage :: HIplImage -> IO HIplImage
 compatibleImage img = 
     do ptr <- newForeignPtr finalizerFree =<< mallocArray sz
-       return $ HIplImage (#size IplImage) nc d 0 0 w h sz ptr stride ptr
+       return $ HIplImage nc d 0 0 w h sz ptr stride ptr
     where w = width img
           h = height img
-          nc = nChannels img
+          nc = numChannels img
           d = depth img
           sz = imageSize img
           stride = widthStep img
@@ -130,8 +128,7 @@ fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage
 fromPixels w h pix = unsafePerformIO $ 
                      V.unsafeWith pix $
                          \p -> do fp <- newForeignPtr_ p
-                                  return $ HIplImage (#size IplImage) nc 
-                                                     iplDepth8u 0 0 w' h'
+                                  return $ HIplImage nc iplDepth8u 0 0 w' h'
                                                      sz fp stride fp
     where sz = V.length pix
           nc = if sz == w'*h' then 1 else 3
@@ -144,26 +141,6 @@ fromPixels w h pix = unsafePerformIO $
 withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
 withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
 
--- |Erode an 'HIplImage' with a 3x3 structuring element for the
--- specified number of iterations.
-erode :: HIplImage -> Int -> HIplImage
-erode img n = unsafePerformIO $ 
-              do destImg <- compatibleImage img
-                 withHIplImage img (\src -> withHIplImage destImg $
-                                            \dst -> cvErode src dst n')
-                 return destImg
-    where n' = fromIntegral n
-
--- |Dilate an 'HIplImage' with a 3x3 structuring element for the
--- specified number of iterations.
-dilate :: HIplImage -> Int -> HIplImage
-dilate img n = unsafePerformIO $ 
-               do destImg <- compatibleImage img
-                  withHIplImage img (\src -> withHIplImage destImg $
-                                             \dst -> cvDilate src dst n')
-                  return destImg
-    where n' = fromIntegral n
-
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
 -- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
@@ -178,9 +155,9 @@ instance Storable HIplImage where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke ptr himg = do
-      (#poke IplImage, nSize) ptr (nSize himg)
+      (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
       (#poke IplImage, ID) ptr (0::Int)
-      (#poke IplImage, nChannels) ptr (nChannels himg)
+      (#poke IplImage, nChannels) ptr (numChannels himg)
       (#poke IplImage, depth) ptr (unDepth (depth himg))
       (#poke IplImage, dataOrder) ptr (dataOrder himg)
       (#poke IplImage, origin) ptr (origin himg)
@@ -196,8 +173,7 @@ instance Storable HIplImage where
       withForeignPtr (imageDataOrigin himg) $ 
          \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
-      nSize' <- (#peek IplImage, nSize) ptr
-      nChannels' <- (#peek IplImage, nChannels) ptr
+      numChannels' <- (#peek IplImage, nChannels) ptr
       depth' <- Depth <$> (#peek IplImage, depth) ptr
       dataOrder' <- (#peek IplImage, dataOrder) ptr
       origin' <- (#peek IplImage, origin) ptr
@@ -207,7 +183,7 @@ instance Storable HIplImage where
       imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
       widthStep' <- (#peek IplImage, widthStep) ptr
       imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
-      return $ HIplImage nSize' nChannels' depth' dataOrder' origin' 
+      return $ HIplImage numChannels' depth' dataOrder' origin' 
                          width' height' imageSize' imageData' widthStep' 
                          imageDataOrigin'
 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 847be1c..63271c2 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -53,7 +53,7 @@ isolateChannel ch img =
                             | otherwise = do VM.unsafeWrite v p (get p3)
                                              go (x+1) (p+1) (p3+3) y
                     go 0 0 ch 0
-    where numCh = nChannels img
+    where numCh = numChannels img
           w = width img
           h = height img
           margin = widthStep img - (w  * 3)
@@ -62,7 +62,7 @@ isolateChannel ch img =
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
 toMono :: HIplImage -> V.Vector Word8
-toMono img = if nChannels img == 1 then dropAlpha w pix 
+toMono img = if numChannels img == 1 then dropAlpha w pix 
              else runST $ do v <- VM.new (w*h)
                              let go !x !p !p3 !y
                                      | y >= h = VG.unsafeFreeze v

From 2c587a7291b60d523bfea230ed5d858020ca96c7 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 2 Aug 2010 21:06:58 -0400
Subject: [PATCH 006/137] Moving high-level pure-Haskell interfaces to the HCV
 module. Added a helper for mutating a new HIplImage value in-place.

---
 HOpenCV.cabal                  |  1 +
 src/AI/CV/OpenCV/CV.hsc        | 11 +++++-
 src/AI/CV/OpenCV/HIplImage.hsc | 62 +++++++++++++++-------------------
 3 files changed, 38 insertions(+), 36 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index bf5f28e..a8b1073 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -28,6 +28,7 @@ library
       AI.CV.OpenCV.HighGui
       AI.CV.OpenCV.Types
       AI.CV.OpenCV.HIplImage
+      AI.CV.OpenCV.HCV
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
    c-sources:
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index 0a8c07e..ae6e504 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -2,7 +2,7 @@
 -- |Support for features from the OpenCV Image Filtering library.
 module AI.CV.OpenCV.CV 
     ( InterpolationMethod(..),
-      cvCanny, cvResize, cvDilate, cvErode, cvPyrDown,
+      cvCanny, cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
       CvHaarClassifierCascade, HaarDetectFlag,
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
@@ -59,6 +59,15 @@ foreign import ccall unsafe "opencv/cv.h cvErode"
 cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
 cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
 
+foreign import ccall unsafe "opencv/cv.h cvHoughLines2"
+        c_cvHoughLines2 :: Ptr CvArr -> Ptr CvMemStorage -> CInt -> CDouble -> CDouble -> CInt -> CDouble -> CDouble -> IO (Ptr (CvSeq a))
+
+cvHoughLines2 :: IplArrayType i => Ptr i -> Ptr CvMemStorage -> CInt -> Double -> Double -> Int -> Double -> Double -> IO (Ptr (CvSeq a))
+cvHoughLines2 img storage method rho theta threshold param1 param2 = 
+    c_cvHoughLines2 (fromArr img) storage method (realToFrac rho) 
+                    (realToFrac theta) (fromIntegral threshold) 
+                    (realToFrac param1) (realToFrac param2)
+
 foreign import ccall unsafe "opencv/cv.h cvCvtColor"
   c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index b7fe07a..8b5a0bf 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,14 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.HIplImage where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
-import AI.CV.OpenCV.CV (cvErode, cvDilate)
 import Control.Applicative ((<$>))
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc (alloca, finalizerFree)
-import Foreign.Marshal.Array (mallocArray, copyArray)
+import Foreign.Marshal.Array (mallocArray)
 import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe
@@ -45,31 +44,17 @@ IplImage;
 
 -- |A Haskell data structure representing the information OpenCV uses
 -- from an 'IplImage' struct.
-data HIplImage = HIplImage { numChannels       :: Int
+data HIplImage = HIplImage { numChannels     :: Int
                            , depth           :: Depth
                            , dataOrder       :: Int
                            , origin          :: Int
                            , width           :: Int
                            , height          :: Int
---                         , roi             :: Ptr ()
-                           , imageSize       :: Int 
+                           , imageSize       :: Int
                            , imageData       :: ForeignPtr Word8
                            , widthStep       :: Int
                            , imageDataOrigin :: ForeignPtr Word8 }
 
--- |Return a 'V.Vector' containing a copy of the pixels that make up
--- the 8-bit-per-pixel 'HIplImage'.
-pixelsCopy :: HIplImage -> IO (V.Vector Word8)
-pixelsCopy img = do dst <- mallocArray sz
-                    withForeignPtr src $ \src' -> copyArray dst src' sz
-                    fptr <- newForeignPtr finalizerFree dst
-                    return $ V.unsafeFromForeignPtr fptr 0 sz
-    where sz = imageSize img
-          src = case depth img of
-                  Depth 8 -> imageData img
-                  x -> error $ "Pixel depth must be 8, "++show x++
-                               " is not supported"
-
 -- |Return a 'V.Vector' containing the pixels that make up an
 -- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
 -- data!
@@ -80,7 +65,6 @@ pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
                   x -> error $ "Pixel depth must be 8, "++show x++
                                " is not supported"
 
-
 -- |Return a 'V.Vector' containing the pixels that make up the
 -- 16-bit-per-pixel 'HIplImage'.
 pixels16 :: HIplImage -> V.Vector Word16
@@ -97,27 +81,24 @@ fromPtr = peek . castPtr
 -- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
 -- and number of color channels with an allocated pixel buffer.
 mkHIplImage :: Int -> Int -> Int -> IO HIplImage
-mkHIplImage w h numChan = do buffer <- mallocArray numBytes
-                             ptr <- newForeignPtr finalizerFree buffer
-                             return $ HIplImage numChan
-                                                iplDepth8u 0 0 w h
-                                                numBytes
-                                                ptr
-                                                (w*numChan)
-                                                ptr
-    where numBytes = w * h * numChan
+mkHIplImage w h numChan = 
+    do ptr <- mallocArray numBytes >>= newForeignPtr finalizerFree
+       return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride ptr
+    where numBytes = stride * h
+          stride = w * numChan
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
 compatibleImage :: HIplImage -> IO HIplImage
 compatibleImage img = 
-    do ptr <- newForeignPtr finalizerFree =<< mallocArray sz
-       return $ HIplImage nc d 0 0 w h sz ptr stride ptr
+    do ptr <- mallocArray sz >>= newForeignPtr finalizerFree
+       return $ HIplImage nc d order 0 w h sz ptr stride ptr
     where w = width img
           h = height img
           nc = numChannels img
           d = depth img
+          order = dataOrder img
           sz = imageSize img
           stride = widthStep img
 
@@ -130,17 +111,26 @@ fromPixels w h pix = unsafePerformIO $
                          \p -> do fp <- newForeignPtr_ p
                                   return $ HIplImage nc iplDepth8u 0 0 w' h'
                                                      sz fp stride fp
-    where sz = V.length pix
-          nc = if sz == w'*h' then 1 else 3
-          stride = w' * nc
+    where nc = if V.length pix == w' * h' then 1 else 3
           w' = fromIntegral w
           h' = fromIntegral h
+          sz = w' * h' * nc
+          stride = w' * nc
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
 withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
 
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'HIplImage' of the same dimensions as the given
+-- 'HIplImage'.
+withCompatibleImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
+withCompatibleImage img1 f = unsafePerformIO $ 
+                             do img2 <- compatibleImage img1
+                                _ <- withHIplImage img2 f
+                                return img2
+
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
 -- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
@@ -171,7 +161,7 @@ instance Storable HIplImage where
       withForeignPtr (imageData himg) $ \p -> (#poke IplImage, imageData) ptr p
       (#poke IplImage, widthStep) ptr (widthStep himg)
       withForeignPtr (imageDataOrigin himg) $ 
-         \p ->(#poke IplImage, imageDataOrigin) ptr p
+        \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
       numChannels' <- (#peek IplImage, nChannels) ptr
       depth' <- Depth <$> (#peek IplImage, depth) ptr
@@ -182,11 +172,13 @@ instance Storable HIplImage where
       imageSize' <- (#peek IplImage, imageSize) ptr
       imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
       widthStep' <- (#peek IplImage, widthStep) ptr
-      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
+      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= 
+                          newForeignPtr_
       return $ HIplImage numChannels' depth' dataOrder' origin' 
                          width' height' imageSize' imageData' widthStep' 
                          imageDataOrigin'
 
 
 
+
                     

From 8ad052386803b5ea826ddaa9be23c33dfec46b5d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 2 Aug 2010 22:28:07 -0400
Subject: [PATCH 007/137] Wrapped loading and saving images and drawing lines.

To support this, there is now functionality for duplicating images.
---
 src/AI/CV/OpenCV/CxCore.hsc     | 14 +++++++++++++
 src/AI/CV/OpenCV/HIplImage.hsc  | 37 ++++++++++++++++++++++++++++++++-
 src/AI/CV/OpenCV/HOpenCV_wrap.c |  8 +++++++
 src/AI/CV/OpenCV/HOpenCV_wrap.h |  3 +++
 src/AI/CV/OpenCV/HighGui.hs     | 21 +++++++++++++++++++
 5 files changed, 82 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index ad69704..4d63873 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -282,6 +282,20 @@ foreign import ccall unsafe "HOpenCV_wrap.h c_cvRectangle"
 cvRectangle :: IplArrayType a => Ptr a -> CvRect -> IO ()
 cvRectangle dst (CvRect x y w h) = c_cvRectangle (fromArr dst) x y w h
 
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvLine"
+        c_cvLine :: Ptr CvArr -> CInt -> CInt  -> CInt -> CInt -> 
+                    CDouble -> CDouble -> CDouble -> CInt -> 
+                    CInt -> CInt -> IO ()
+
+cvLine :: IplArrayType a => Ptr a -> (Int, Int)  -> (Int, Int) -> 
+                    (Double, Double, Double) -> Int -> 
+                    Int -> IO ()
+cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
+    c_cvLine (fromArr dst) (fi x1) (fi y1) (fi x2) (fi y2) 
+             (fr r) (fr g) (fr b) (fi thickness) (fi lineType) 0 
+        where fi = fromIntegral
+              fr = realToFrac
+
 ------------------------------------------------------------------------------
 -- Debugging stuff, not part of opencv
 
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 8b5a0bf..2a8f06e 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,13 +1,14 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.HIplImage where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
+import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
 import Control.Applicative ((<$>))
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc (alloca, finalizerFree)
-import Foreign.Marshal.Array (mallocArray)
+import Foreign.Marshal.Array (mallocArray, copyArray)
 import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe
@@ -78,6 +79,15 @@ pixels16 img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
 fromPtr :: Ptr IplImage -> IO HIplImage
 fromPtr = peek . castPtr
 
+-- |Load an 'HIplImage' from an image file on disk. The first argument
+-- is the name of the file to load. The second argument determines
+-- the desired color format of the image.
+fromFile :: String -> LoadColor -> IO HIplImage
+fromFile fileName col = fromPtr =<< cvLoadImage fileName col
+
+toFile :: String -> HIplImage -> IO ()
+toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
+
 -- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
 -- and number of color channels with an allocated pixel buffer.
 mkHIplImage :: Int -> Int -> Int -> IO HIplImage
@@ -102,6 +112,22 @@ compatibleImage img =
           sz = imageSize img
           stride = widthStep img
 
+-- |Create an exact duplicate of the given HIplImage. This allocates a
+-- fresh array to store the copied pixels.
+duplicateImage :: HIplImage -> IO HIplImage
+duplicateImage img =
+    do ptr <- mallocArray sz
+       withForeignPtr (imageData img) $ 
+           \src -> copyArray ptr src sz
+       fptr <- newForeignPtr finalizerFree ptr
+       return $ HIplImage nc d 0 0 w h sz fptr stride fptr
+    where w = width img
+          h = height img
+          nc = numChannels img
+          d = depth img
+          sz = imageSize img
+          stride = widthStep img
+
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
 -- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
 -- with the supplied 'V.Vector'.
@@ -122,6 +148,15 @@ fromPixels w h pix = unsafePerformIO $
 withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
 withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
 
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'HIplImage' that is an exact duplicate of the
+-- given 'HIplImage'.
+withDuplicateImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
+withDuplicateImage img1 f = unsafePerformIO $
+                            do img2 <- duplicateImage img1
+                               _ <- withHIplImage img2 f
+                               return img2
+
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c
index 727c912..80d95b8 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c
@@ -133,6 +133,14 @@ void c_cvRectangle(CvArr *img, int x, int y, int width, int height)
                 CV_RGB(255,0,0), 3 , 8, 0);
 }
 
+void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
+              double b, int thickness, int lineType, int shift)
+{
+    cvLine(img, cvPoint(x1,y1), cvPoint(x2,y2), CV_RGB(r,g,b), thickness, 
+           lineType, shift);
+}
+
+
 /****************************************************************************/
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/HOpenCV_wrap.h
index 81f9844..41a9bfc 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.h
@@ -27,6 +27,9 @@ int seq_total(const CvSeq *seq);
 
 void c_cvRectangle(CvArr *img, int x, int y, int width, int height);
 
+void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
+              double b, int thickness, int lineType, int shift);
+
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index 126cca5..7458ef0 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -19,6 +19,27 @@ foreign import ccall unsafe "highgui.h cvConvertImage"
 cvConvertImage :: (IplArrayType a, IplArrayType a1) => Ptr a -> Ptr a1 -> CInt -> IO ()
 cvConvertImage src dst flags = c_cvConvertImage (fromArr src) (fromArr dst) flags
 
+-- |Determine the color model of an image loaded from a file.
+data LoadColor = LoadColor     -- ^Force a 3-channel color image
+               | LoadGray      -- ^Force a grayscale image
+               | LoadUnchanged -- ^Load the image as is
+                 deriving Enum
+
+foreign import ccall unsafe "highgui.h cvLoadImage"
+  c_cvLoadImage :: CString -> CInt -> IO (Ptr IplImage)
+
+cvLoadImage :: String -> LoadColor -> IO (Ptr IplImage)
+cvLoadImage fileName col = withCString fileName $ 
+                           \str -> c_cvLoadImage str col'
+    where col' = fromIntegral $ fromEnum col
+
+foreign import ccall unsafe "highgui.h cvSaveImage"
+  c_cvSaveImage :: CString -> Ptr CvArr -> IO ()
+
+cvSaveImage :: IplArrayType a => String -> Ptr a -> IO ()
+cvSaveImage fileName img = withCString fileName $
+                           \str -> c_cvSaveImage str (fromArr img)
+
 ------------------------------------------------
 -- Capturing
 data CvCapture

From b6d43cd90969532e9a4193305f96737e350a8e83 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 2 Aug 2010 22:32:39 -0400
Subject: [PATCH 008/137] Added the HCV module that provides the functional
 interface to various OpenCV functions on images.

---
 src/AI/CV/OpenCV/HCV.hs | 94 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/HCV.hs

diff --git a/src/AI/CV/OpenCV/HCV.hs b/src/AI/CV/OpenCV/HCV.hs
new file mode 100644
index 0000000..b6dac7b
--- /dev/null
+++ b/src/AI/CV/OpenCV/HCV.hs
@@ -0,0 +1,94 @@
+-- High-level pure Haskell bindings to OpenCV operations.
+module AI.CV.OpenCV.HCV where
+import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.CV
+import AI.CV.OpenCV.HIplImage
+import Foreign.Ptr
+import Foreign.Storable
+import System.IO.Unsafe
+
+-- NOTE: These operations allocate a fresh HIplImage on each invocation. The invocation is managed manually so that we obtain a pointer
+
+-- |Erode an 'HIplImage' with a 3x3 structuring element for the
+-- specified number of iterations.
+erode :: HIplImage -> Int -> HIplImage
+erode img n = unsafePerformIO $
+              withHIplImage img (\src -> return . withCompatibleImage img $
+                                         \dst -> cvErode src dst n')
+{-
+erode img n = unsafePerformIO $ 
+              do let destImg = compatibleImage img
+                 withHIplImage img (\src -> withHIplImage destImg $
+                                            \dst -> cvErode src dst n')
+                 return destImg
+-}
+    where n' = fromIntegral n
+
+-- |Dilate an 'HIplImage' with a 3x3 structuring element for the
+-- specified number of iterations.
+dilate :: HIplImage -> Int -> HIplImage
+dilate img n = unsafePerformIO $
+               withHIplImage img (\src -> return . withCompatibleImage img $
+                                          \dst -> cvDilate src dst n')
+{-
+dilate img n = unsafePerformIO $ 
+               do destImg <- compatibleImage img
+                  withHIplImage img (\src -> withHIplImage destImg $
+                                             \dst -> cvDilate src dst n')
+                  return destImg
+-}
+    where n' = fromIntegral n
+
+-- |Line detection in a binary image using a standard Hough transform.
+houghStandard :: Double -> Double -> Int -> HIplImage -> [(Float, Float)]
+houghStandard rho theta threshold img = unsafePerformIO $
+    do storage <- cvCreateMemStorage 0
+       cvSeq <- withHIplImage img $ 
+                \p -> cvHoughLines2 p storage 0 rho theta threshold 0 0
+       hlines <- mapM (\p -> do f1 <- peek p
+                                f2 <- peek (plusPtr p (sizeOf (undefined::Float)))
+                                return (f1,f2))
+                      =<< seqToPList cvSeq
+       cvReleaseMemStorage storage
+       return hlines
+
+-- |Line detection in a binary image using a probabilistic Hough transform.
+houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
+                      HIplImage -> [((Int, Int),(Int,Int))]
+houghProbabilistic rho theta threshold minLength maxGap img = 
+    unsafePerformIO $ do storage <- cvCreateMemStorage 0
+                         cvSeq <- withHIplImage img $
+                                  \p -> cvHoughLines2 p storage 1 rho theta 
+                                                      threshold minLength 
+                                                      maxGap
+                         hlines <- mapM (\p1 -> do x1 <- peek p1
+                                                   let step = sizeOf (undefined::Int)
+                                                       p2 = plusPtr p1 step
+                                                       p3 = plusPtr p2 step
+                                                       p4 = plusPtr p3 step
+                                                   y1 <- peek p2
+                                                   x2 <- peek p3
+                                                   y2 <- peek p4
+                                                   return ((x1,y1),(x2,y2)))
+                                         =<< seqToPList cvSeq
+                         cvReleaseMemStorage storage
+                         return hlines
+
+-- |Type of line to draw.
+data LineType = EightConn -- ^8-connected line
+              | FourConn  -- ^4-connected line
+              | AALine    -- ^antialiased line
+
+-- |Convert a LineType into an integer.
+lineTypeEnum :: LineType -> Int
+lineTypeEnum EightConn = 8
+lineTypeEnum FourConn  = 4
+lineTypeEnum AALine    = 16
+
+-- |Draw each line, defined by its endpoits, on top of a duplicate of
+-- the given 'HIplImage'.
+drawLines :: HIplImage -> [((Int,Int),(Int,Int))] -> HIplImage
+drawLines img lines = withDuplicateImage img $
+                      \ptr -> mapM_ (drawLine ptr (1,0,0) 2 8) lines
+    where drawLine ptr col thick lineType (pt1, pt2) = 
+              cvLine ptr pt1 pt2 col thick lineType
\ No newline at end of file

From a3532cb402a65f6857b93e2540ee682c54020f2c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 3 Aug 2010 09:51:51 -0400
Subject: [PATCH 009/137] Added the color conversion enumeration.

---
 src/AI/CV/OpenCV/ColorConversion.hsc | 84 ++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/ColorConversion.hsc

diff --git a/src/AI/CV/OpenCV/ColorConversion.hsc b/src/AI/CV/OpenCV/ColorConversion.hsc
new file mode 100644
index 0000000..5879c08
--- /dev/null
+++ b/src/AI/CV/OpenCV/ColorConversion.hsc
@@ -0,0 +1,84 @@
+-- |Constants for color conversion
+module AI.CV.OpenCV.ColorConversion where
+import Foreign.C.Types (CInt)
+
+#include <opencv/cv.h>
+
+newtype ColorConversion = ColorConversion { colorConv :: CInt }
+
+-- Note: See Util/ColorConversion.rkt for a Racket script to convert
+-- the C #defines to the below hsc2hs code.
+#{enum ColorConversion, ColorConversion
+  , cv_BGR2BGRA = CV_BGR2BGRA
+  , cv_RGB2RGBA = CV_RGB2RGBA
+  , cv_BGRA2BGR = CV_BGRA2BGR
+  , cv_RGBA2RGB = CV_RGBA2RGB
+  , cv_BGR2RGBA = CV_BGR2RGBA
+  , cv_RGB2BGRA = CV_RGB2BGRA
+  , cv_RGBA2BGR = CV_RGBA2BGR
+  , cv_BGRA2RGB = CV_BGRA2RGB
+  , cv_BGR2RGB = CV_BGR2RGB
+  , cv_RGB2BGR = CV_RGB2BGR
+  , cv_BGRA2RGBA = CV_BGRA2RGBA
+  , cv_RGBA2BGRA = CV_RGBA2BGRA
+  , cv_BGR2GRAY = CV_BGR2GRAY
+  , cv_RGB2GRAY = CV_RGB2GRAY
+  , cv_GRAY2BGR = CV_GRAY2BGR
+  , cv_GRAY2RGB = CV_GRAY2RGB
+  , cv_GRAY2BGRA = CV_GRAY2BGRA
+  , cv_GRAY2RGBA = CV_GRAY2RGBA
+  , cv_BGRA2GRAY = CV_BGRA2GRAY
+  , cv_RGBA2GRAY = CV_RGBA2GRAY
+  , cv_BGR2BGR565 = CV_BGR2BGR565
+  , cv_RGB2BGR565 = CV_RGB2BGR565
+  , cv_BGR5652BGR = CV_BGR5652BGR
+  , cv_BGR5652RGB = CV_BGR5652RGB
+  , cv_BGRA2BGR565 = CV_BGRA2BGR565
+  , cv_RGBA2BGR565 = CV_RGBA2BGR565
+  , cv_BGR5652BGRA = CV_BGR5652BGRA
+  , cv_BGR5652RGBA = CV_BGR5652RGBA
+  , cv_GRAY2BGR565 = CV_GRAY2BGR565
+  , cv_BGR5652GRAY = CV_BGR5652GRAY
+  , cv_BGR2BGR555 = CV_BGR2BGR555
+  , cv_RGB2BGR555 = CV_RGB2BGR555
+  , cv_BGR5552BGR = CV_BGR5552BGR
+  , cv_BGR5552RGB = CV_BGR5552RGB
+  , cv_BGRA2BGR555 = CV_BGRA2BGR555
+  , cv_RGBA2BGR555 = CV_RGBA2BGR555
+  , cv_BGR5552BGRA = CV_BGR5552BGRA
+  , cv_BGR5552RGBA = CV_BGR5552RGBA
+  , cv_GRAY2BGR555 = CV_GRAY2BGR555
+  , cv_BGR5552GRAY = CV_BGR5552GRAY
+  , cv_BGR2XYZ = CV_BGR2XYZ
+  , cv_RGB2XYZ = CV_RGB2XYZ
+  , cv_XYZ2BGR = CV_XYZ2BGR
+  , cv_XYZ2RGB = CV_XYZ2RGB
+  , cv_BGR2YCrCb = CV_BGR2YCrCb
+  , cv_RGB2YCrCb = CV_RGB2YCrCb
+  , cv_YCrCb2BGR = CV_YCrCb2BGR
+  , cv_YCrCb2RGB = CV_YCrCb2RGB
+  , cv_BGR2HSV = CV_BGR2HSV
+  , cv_RGB2HSV = CV_RGB2HSV
+  , cv_BGR2Lab = CV_BGR2Lab
+  , cv_RGB2Lab = CV_RGB2Lab
+  , cv_BayerBG2BGR = CV_BayerBG2BGR
+  , cv_BayerGB2BGR = CV_BayerGB2BGR
+  , cv_BayerRG2BGR = CV_BayerRG2BGR
+  , cv_BayerGR2BGR = CV_BayerGR2BGR
+  , cv_BayerBG2RGB = CV_BayerBG2RGB
+  , cv_BayerGB2RGB = CV_BayerGB2RGB
+  , cv_BayerRG2RGB = CV_BayerRG2RGB
+  , cv_BayerGR2RGB = CV_BayerGR2RGB
+  , cv_BGR2Luv = CV_BGR2Luv
+  , cv_RGB2Luv = CV_RGB2Luv
+  , cv_BGR2HLS = CV_BGR2HLS
+  , cv_RGB2HLS = CV_RGB2HLS
+  , cv_HSV2BGR = CV_HSV2BGR
+  , cv_HSV2RGB = CV_HSV2RGB
+  , cv_Lab2BGR = CV_Lab2BGR
+  , cv_Lab2RGB = CV_Lab2RGB
+  , cv_Luv2BGR = CV_Luv2BGR
+  , cv_Luv2RGB = CV_Luv2RGB
+  , cv_HLS2BGR = CV_HLS2BGR
+  , cv_HLS2RGB = CV_HLS2RGB
+  }
\ No newline at end of file

From 67c8cdab42d3d2a3ee6af57becea6869721f8579 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 3 Aug 2010 09:52:21 -0400
Subject: [PATCH 010/137] Renamed HCV.hs to HighCV.hs

---
 src/AI/CV/OpenCV/{HCV.hs => HighCV.hs} | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 rename src/AI/CV/OpenCV/{HCV.hs => HighCV.hs} (100%)

diff --git a/src/AI/CV/OpenCV/HCV.hs b/src/AI/CV/OpenCV/HighCV.hs
similarity index 100%
rename from src/AI/CV/OpenCV/HCV.hs
rename to src/AI/CV/OpenCV/HighCV.hs

From 3aabf439c14e2b8926e388a9cbb79123724d766f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 3 Aug 2010 12:21:40 -0400
Subject: [PATCH 011/137] Exposed high-level color conversion. Implemented
 in-place fusion compiler rules. Made the houghStandard output type match
 houghProbabilistic's.

The in-place optimizations are all using unsafePerformIO at the
moment, and this will have to change as it is, of course, totally
unsafe. While the RULES pragma is firing correctly, other
optimizations are killing the operations. They will have to be moved
into ST or explicitly marked as IO.
---
 HOpenCV.cabal                        |   4 +-
 src/AI/CV/OpenCV/CV.hsc              |   5 +-
 src/AI/CV/OpenCV/ColorConversion.hsc |   6 +-
 src/AI/CV/OpenCV/HIplImage.hsc       |  11 ++-
 src/AI/CV/OpenCV/HighCV.hs           | 138 ++++++++++++++++++++-------
 5 files changed, 121 insertions(+), 43 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index a8b1073..84c3b38 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -28,7 +28,7 @@ library
       AI.CV.OpenCV.HighGui
       AI.CV.OpenCV.Types
       AI.CV.OpenCV.HIplImage
-      AI.CV.OpenCV.HCV
+      AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
    c-sources:
@@ -39,7 +39,7 @@ library
                   allocated-processor >= 0.0.1, 
                   vector-space,
                   vector >= 0.6.0.2 && < 0.7
-   ghc-options: -Wall -fno-warn-type-defaults
+   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing
 
 executable test-hopencv
   c-sources:
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index ae6e504..5af38d1 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -76,8 +76,9 @@ foreign import ccall unsafe "opencv/cv.h cvCvtColor"
 -- first and the same depth, but it's number of color channels may be
 -- different and must be compatible with the given 'ColorConversion'
 -- code.
-cvCvtColor :: Ptr CvArr -> Ptr CvArr -> ColorConversion -> IO ()
-cvCvtColor src dst code = c_cvCvtColor src dst (colorConv code)
+cvCvtColor :: (IplArrayType a, IplArrayType b) => 
+              Ptr a -> Ptr b -> ColorConversion -> IO ()
+cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
diff --git a/src/AI/CV/OpenCV/ColorConversion.hsc b/src/AI/CV/OpenCV/ColorConversion.hsc
index 5879c08..e1751d5 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hsc
+++ b/src/AI/CV/OpenCV/ColorConversion.hsc
@@ -4,10 +4,10 @@ import Foreign.C.Types (CInt)
 
 #include <opencv/cv.h>
 
-newtype ColorConversion = ColorConversion { colorConv :: CInt }
+newtype ColorConversion = ColorConversion { colorConv :: CInt } deriving Eq
 
--- Note: See Util/ColorConversion.rkt for a Racket script to convert
--- the C #defines to the below hsc2hs code.
+-- Note: See Util/ColorConversion.hs for a script to convert the C
+-- #defines to the below hsc2hs code.
 #{enum ColorConversion, ColorConversion
   , cv_BGR2BGRA = CV_BGR2BGRA
   , cv_RGB2RGBA = CV_RGB2RGBA
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 2a8f06e..9ee30c6 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,6 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.HIplImage where
-import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
+import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u,createImageF,
+                            CvSize(..))
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
 import Control.Applicative ((<$>))
 import qualified Data.Vector.Storable as V
@@ -92,6 +93,11 @@ toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 -- and number of color channels with an allocated pixel buffer.
 mkHIplImage :: Int -> Int -> Int -> IO HIplImage
 mkHIplImage w h numChan = 
+--     do fp <- createImageF (CvSize w' h') numChan' iplDepth8u
+--        withForeignPtr fp $ \p -> peek (castPtr p)
+--     where w' = fromIntegral w
+--           h' = fromIntegral h
+--           numChan' = fromIntegral numChan
     do ptr <- mallocArray numBytes >>= newForeignPtr finalizerFree
        return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride ptr
     where numBytes = stride * h
@@ -128,6 +134,7 @@ duplicateImage img =
           sz = imageSize img
           stride = widthStep img
 
+{-# NOINLINE fromPixels #-}
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
 -- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
 -- with the supplied 'V.Vector'.
@@ -148,6 +155,7 @@ fromPixels w h pix = unsafePerformIO $
 withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
 withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
 
+{-# NOINLINE withDuplicateImage #-}
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'.
@@ -157,6 +165,7 @@ withDuplicateImage img1 f = unsafePerformIO $
                                _ <- withHIplImage img2 f
                                return img2
 
+{-# NOINLINE withCompatibleImage #-}
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index b6dac7b..8592030 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -1,5 +1,10 @@
--- High-level pure Haskell bindings to OpenCV operations.
-module AI.CV.OpenCV.HCV where
+-- |High-level Haskell bindings to OpenCV operations. Some of
+-- these operations are fusable under composition. For example,
+-- @dilate 8 . erode 8@ will allocate one new image rather than two.
+module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
+                            LineType(..), RGB, drawLines, convertColor) 
+    where
+import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HIplImage
@@ -7,42 +12,55 @@ import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe
 
--- NOTE: These operations allocate a fresh HIplImage on each invocation. The invocation is managed manually so that we obtain a pointer
-
+{-# NOINLINE erode #-}
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: HIplImage -> Int -> HIplImage
-erode img n = unsafePerformIO $
+erode :: Int -> HIplImage -> HIplImage
+erode n img = unsafePerformIO $
               withHIplImage img (\src -> return . withCompatibleImage img $
                                          \dst -> cvErode src dst n')
-{-
-erode img n = unsafePerformIO $ 
-              do let destImg = compatibleImage img
-                 withHIplImage img (\src -> withHIplImage destImg $
-                                            \dst -> cvErode src dst n')
-                 return destImg
--}
     where n' = fromIntegral n
 
+{-# NOINLINE dilate #-}
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: HIplImage -> Int -> HIplImage
-dilate img n = unsafePerformIO $
+dilate :: Int -> HIplImage -> HIplImage
+dilate n img = unsafePerformIO $
                withHIplImage img (\src -> return . withCompatibleImage img $
                                           \dst -> cvDilate src dst n')
-{-
-dilate img n = unsafePerformIO $ 
-               do destImg <- compatibleImage img
-                  withHIplImage img (\src -> withHIplImage destImg $
-                                             \dst -> cvDilate src dst n')
-                  return destImg
--}
     where n' = fromIntegral n
 
+{-# NOINLINE unsafeErode #-}
+-- |Unsafe in-place erosion. This is a destructive update of the given
+-- image and is only used by the fusion rewrite rules when there is
+-- no way to observe the input image.
+unsafeErode :: Int -> HIplImage -> HIplImage
+unsafeErode n img = unsafePerformIO $ 
+                    withHIplImage img (\src -> cvErode src src n') >> 
+                    return img
+    where n' = fromIntegral n
+
+{-# NOINLINE unsafeDilate #-}
+-- |Unsafe in-place dilation. This is a destructive update of the
+-- given image and is only used by the fusion rewrite rules when
+-- there is no way to observe the input image.
+unsafeDilate :: Int -> HIplImage -> HIplImage
+unsafeDilate n img = unsafePerformIO $
+                     withHIplImage img (\src -> cvDilate src src n') >> 
+                     return img
+    where n' = fromIntegral n
+
+-- Perform destructive in-place updates when such a change is safe.
+{-# RULES 
+"erode-in-place"  forall n f. erode n . f = unsafeErode n . f
+"dilate-in-place" forall n f. dilate n . f = unsafeDilate n . f
+  #-}
+
+{-# NOINLINE houghStandard #-}
 -- |Line detection in a binary image using a standard Hough transform.
-houghStandard :: Double -> Double -> Int -> HIplImage -> [(Float, Float)]
+houghStandard :: Double -> Double -> Int -> HIplImage -> [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = unsafePerformIO $
-    do storage <- cvCreateMemStorage 0
+    do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        cvSeq <- withHIplImage img $ 
                 \p -> cvHoughLines2 p storage 0 rho theta threshold 0 0
        hlines <- mapM (\p -> do f1 <- peek p
@@ -50,20 +68,32 @@ houghStandard rho theta threshold img = unsafePerformIO $
                                 return (f1,f2))
                       =<< seqToPList cvSeq
        cvReleaseMemStorage storage
-       return hlines
+       return $ map lineToSeg hlines
+    where lineToSeg :: (Float,Float) -> ((Int,Int),(Int,Int))
+          lineToSeg (rho, theta) = let a = cos theta
+                                       b = sin theta
+                                       x0 = a * rho
+                                       y0 = b * rho
+                                       x1 = clampX $ x0 + 10000*(-b)
+                                       y1 = clampY $ y0 + 10000*a
+                                       x2 = clampX $ x0 - 10000*(-b)
+                                       y2 = clampY $ y0 - 10000*a
+                                   in ((x1,y1),(x2,y2))
+          clampX x = max 0 (min (truncate x) (width img - 1))
+          clampY y = max 0 (min (truncate y) (height img - 1))
 
+{-# NOINLINE houghProbabilistic #-}
 -- |Line detection in a binary image using a probabilistic Hough transform.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
                       HIplImage -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
-    unsafePerformIO $ do storage <- cvCreateMemStorage 0
+    unsafePerformIO $ do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
                          cvSeq <- withHIplImage img $
                                   \p -> cvHoughLines2 p storage 1 rho theta 
                                                       threshold minLength 
                                                       maxGap
                          hlines <- mapM (\p1 -> do x1 <- peek p1
-                                                   let step = sizeOf (undefined::Int)
-                                                       p2 = plusPtr p1 step
+                                                   let p2 = plusPtr p1 step
                                                        p3 = plusPtr p2 step
                                                        p4 = plusPtr p3 step
                                                    y1 <- peek p2
@@ -73,22 +103,60 @@ houghProbabilistic rho theta threshold minLength maxGap img =
                                          =<< seqToPList cvSeq
                          cvReleaseMemStorage storage
                          return hlines
+        where step = sizeOf (undefined::Int)
 
 -- |Type of line to draw.
 data LineType = EightConn -- ^8-connected line
               | FourConn  -- ^4-connected line
               | AALine    -- ^antialiased line
 
+-- |An RGB triple. 
+type RGB = (Double, Double, Double)
+
 -- |Convert a LineType into an integer.
 lineTypeEnum :: LineType -> Int
 lineTypeEnum EightConn = 8
 lineTypeEnum FourConn  = 4
 lineTypeEnum AALine    = 16
 
--- |Draw each line, defined by its endpoits, on top of a duplicate of
--- the given 'HIplImage'.
-drawLines :: HIplImage -> [((Int,Int),(Int,Int))] -> HIplImage
-drawLines img lines = withDuplicateImage img $
-                      \ptr -> mapM_ (drawLine ptr (1,0,0) 2 8) lines
-    where drawLine ptr col thick lineType (pt1, pt2) = 
-              cvLine ptr pt1 pt2 col thick lineType
\ No newline at end of file
+-- |Draw each line, defined by its endpoints, on a duplicate of the
+-- given 'HIplImage' using the specified RGB color, line thickness,
+-- and aliasing style. This function is fusible under composition.
+drawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> HIplImage -> 
+             HIplImage
+drawLines col thick lineType lines img = 
+    withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
+    where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
+          lineType' = lineTypeEnum lineType
+
+{-# NOINLINE unsafeDrawLines #-}
+-- |Unsafe in-place line drawing.
+unsafeDrawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
+                   HIplImage -> HIplImage
+unsafeDrawLines col thick lineType lines img = 
+    unsafePerformIO $
+    withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return img
+    where lineType' = lineTypeEnum lineType
+          draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
+
+{-# RULES
+  "draw-lines-in-place" forall c t lt lns f. 
+  drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
+  #-}
+
+{-# NOINLINE convertColor #-}
+-- |Convert the color model of an image.
+convertColor :: ColorConversion -> HIplImage -> HIplImage
+convertColor cc img = unsafePerformIO $ 
+                      withHIplImage img $
+                      \src -> do dst <- mkHIplImage w h nc
+                                 withHIplImage dst $
+                                   \dst' -> cvCvtColor src dst' cc
+                                 return dst
+    where w = width img
+          h = height img
+          destChannels = [(cv_RGB2BGR, 3), (cv_BGR2GRAY, 1), (cv_GRAY2BGR, 3)]
+          nc = case lookup cc destChannels of
+                 Just n -> n
+                 Nothing -> error $ "Unfamiliar color conversion. "++
+                                    "Contact maintainer."
\ No newline at end of file

From 5efb4f23a111fa1b78d72ac8fbbe3eb844dd8c3c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 3 Aug 2010 21:07:01 -0400
Subject: [PATCH 012/137] Fixed cvSaveImage wrapper. Changed unsafe operations
 to use ST.

The OpenCV documentation for cvSaveImage is incorrect: it takes a
third parameter that should be set to zero.

Still working out how to do the allocation fusing rules. The difficulty is
in keeping the interface looking like functions but being able to recognize
when fusable operations are composed.
---
 src/AI/CV/OpenCV/HIplImage.hsc  | 117 ++++++++++++++++++++------------
 src/AI/CV/OpenCV/HOpenCV_wrap.c |   7 +-
 src/AI/CV/OpenCV/HighCV.hs      |  72 ++++++++++----------
 src/AI/CV/OpenCV/HighGui.hs     |   9 ++-
 4 files changed, 120 insertions(+), 85 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 9ee30c6..ef18284 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,18 +1,17 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.HIplImage where
-import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u,createImageF,
-                            CvSize(..))
+import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
 import Control.Applicative ((<$>))
+import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc (alloca, finalizerFree)
-import Foreign.Marshal.Array (mallocArray, copyArray)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Array (copyArray)
 import Foreign.Ptr
 import Foreign.Storable
-import System.IO.Unsafe
 
 #include <opencv/cxtypes.h>
 {-
@@ -93,12 +92,12 @@ toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 -- and number of color channels with an allocated pixel buffer.
 mkHIplImage :: Int -> Int -> Int -> IO HIplImage
 mkHIplImage w h numChan = 
---     do fp <- createImageF (CvSize w' h') numChan' iplDepth8u
---        withForeignPtr fp $ \p -> peek (castPtr p)
---     where w' = fromIntegral w
---           h' = fromIntegral h
---           numChan' = fromIntegral numChan
-    do ptr <- mallocArray numBytes >>= newForeignPtr finalizerFree
+    -- do fp <- createImageF (CvSize w' h') numChan' iplDepth8u
+    --    withForeignPtr fp $ \p -> peek (castPtr p)
+    -- where w' = fromIntegral w
+    --       h' = fromIntegral h
+    --       numChan' = fromIntegral numChan
+    do ptr <- mallocForeignPtrArray numBytes
        return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride ptr
     where numBytes = stride * h
           stride = w * numChan
@@ -108,7 +107,7 @@ mkHIplImage w h numChan =
 -- data of the original 'HIplImage' is not copied.
 compatibleImage :: HIplImage -> IO HIplImage
 compatibleImage img = 
-    do ptr <- mallocArray sz >>= newForeignPtr finalizerFree
+    do ptr <- mallocForeignPtrArray sz
        return $ HIplImage nc d order 0 w h sz ptr stride ptr
     where w = width img
           h = height img
@@ -122,10 +121,9 @@ compatibleImage img =
 -- fresh array to store the copied pixels.
 duplicateImage :: HIplImage -> IO HIplImage
 duplicateImage img =
-    do ptr <- mallocArray sz
+    do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
-           \src -> copyArray ptr src sz
-       fptr <- newForeignPtr finalizerFree ptr
+           \src -> withForeignPtr fptr $ \dst -> copyArray dst src sz
        return $ HIplImage nc d 0 0 w h sz fptr stride fptr
     where w = width img
           h = height img
@@ -134,43 +132,73 @@ duplicateImage img =
           sz = imageSize img
           stride = widthStep img
 
-{-# NOINLINE fromPixels #-}
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
 -- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
 -- with the supplied 'V.Vector'.
 fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage
-fromPixels w h pix = unsafePerformIO $ 
-                     V.unsafeWith pix $
-                         \p -> do fp <- newForeignPtr_ p
-                                  return $ HIplImage nc iplDepth8u 0 0 w' h'
-                                                     sz fp stride fp
+-- fromPixels w h pix = runST $ unsafeIOToST $ 
+--                      V.unsafeWith pix $
+--                          \p -> do fp <- newForeignPtr_ p
+--                                   return $ HIplImage nc iplDepth8u 0 0 w' h'
+--                                                      sz fp stride fp
+fromPixels w h pix = if fromIntegral len == sz 
+                     then HIplImage nc iplDepth8u 0 0 w' h' sz fp stride fp
+                     else error "Length disagreement"
     where nc = if V.length pix == w' * h' then 1 else 3
           w' = fromIntegral w
           h' = fromIntegral h
           sz = w' * h' * nc
           stride = w' * nc
+          (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
+                         (fp,0,len) -> (fp,len)
+                         _ -> error "fromPixels non-zero offset"
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
-withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
+--withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
+withHIplImage img f = alloca $ 
+                      \p -> withForeignPtr (imageData img) 
+                                           (\hp -> pokeIpl img p hp >>
+                                                   f (castPtr p))
+
+-- Poke a 'Ptr' 'HIplImage' with a specific imageData 'Ptr' that is
+-- currently valid. This is solely an auxiliary function to
+-- 'withHIplImage'.
+pokeIpl :: HIplImage -> Ptr HIplImage -> Ptr Word8 -> IO ()
+pokeIpl himg ptr hp =
+    do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
+       (#poke IplImage, ID) ptr (0::Int)
+       (#poke IplImage, nChannels) ptr (numChannels himg)
+       (#poke IplImage, depth) ptr (unDepth (depth himg))
+       (#poke IplImage, dataOrder) ptr (dataOrder himg)
+       (#poke IplImage, origin) ptr (origin himg)
+       (#poke IplImage, align) ptr (4::Int)
+       (#poke IplImage, width) ptr (width himg)
+       (#poke IplImage, height) ptr (height himg)
+       (#poke IplImage, roi) ptr nullPtr
+       (#poke IplImage, maskROI) ptr nullPtr
+       (#poke IplImage, imageId) ptr nullPtr
+       (#poke IplImage, tileInfo) ptr nullPtr
+       (#poke IplImage, imageSize) ptr (imageSize himg)
+       (#poke IplImage, imageData) ptr hp
+       (#poke IplImage, widthStep) ptr (widthStep himg)
+       (#poke IplImage, imageDataOrigin) ptr hp
 
-{-# NOINLINE withDuplicateImage #-}
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'.
 withDuplicateImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
-withDuplicateImage img1 f = unsafePerformIO $
+withDuplicateImage img1 f = runST $ unsafeIOToST $
                             do img2 <- duplicateImage img1
                                _ <- withHIplImage img2 f
                                return img2
 
-{-# NOINLINE withCompatibleImage #-}
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
 withCompatibleImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
-withCompatibleImage img1 f = unsafePerformIO $ 
+withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
                                 _ <- withHIplImage img2 f
                                 return img2
@@ -188,24 +216,25 @@ withCompatibleImage img1 f = unsafePerformIO $
 instance Storable HIplImage where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
-    poke ptr himg = do
-      (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
-      (#poke IplImage, ID) ptr (0::Int)
-      (#poke IplImage, nChannels) ptr (numChannels himg)
-      (#poke IplImage, depth) ptr (unDepth (depth himg))
-      (#poke IplImage, dataOrder) ptr (dataOrder himg)
-      (#poke IplImage, origin) ptr (origin himg)
-      (#poke IplImage, width) ptr (width himg)
-      (#poke IplImage, height) ptr (height himg)
-      (#poke IplImage, roi) ptr nullPtr
-      (#poke IplImage, maskROI) ptr nullPtr
-      (#poke IplImage, imageId) ptr nullPtr
-      (#poke IplImage, tileInfo) ptr nullPtr
-      (#poke IplImage, imageSize) ptr (imageSize himg)
-      withForeignPtr (imageData himg) $ \p -> (#poke IplImage, imageData) ptr p
-      (#poke IplImage, widthStep) ptr (widthStep himg)
-      withForeignPtr (imageDataOrigin himg) $ 
-        \p ->(#poke IplImage, imageDataOrigin) ptr p
+    poke = error "Poking a Ptr HIplImage is unsafe."
+    -- poke ptr himg = do
+    --   (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
+    --   (#poke IplImage, ID) ptr (0::Int)
+    --   (#poke IplImage, nChannels) ptr (numChannels himg)
+    --   (#poke IplImage, depth) ptr (unDepth (depth himg))
+    --   (#poke IplImage, dataOrder) ptr (dataOrder himg)
+    --   (#poke IplImage, origin) ptr (origin himg)
+    --   (#poke IplImage, width) ptr (width himg)
+    --   (#poke IplImage, height) ptr (height himg)
+    --   (#poke IplImage, roi) ptr nullPtr
+    --   (#poke IplImage, maskROI) ptr nullPtr
+    --   (#poke IplImage, imageId) ptr nullPtr
+    --   (#poke IplImage, tileInfo) ptr nullPtr
+    --   (#poke IplImage, imageSize) ptr (imageSize himg)
+    --   withForeignPtr (imageData himg) $ \p -> (#poke IplImage, imageData) ptr p
+    --   (#poke IplImage, widthStep) ptr (widthStep himg)
+    --   withForeignPtr (imageDataOrigin himg) $ 
+    --     \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
       numChannels' <- (#peek IplImage, nChannels) ptr
       depth' <- Depth <$> (#peek IplImage, depth) ptr
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c
index 80d95b8..4adcd50 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c
@@ -18,10 +18,13 @@ void debug_print_image_header(IplImage *image)
            "\twidth: %d\n"
            "\theight: %d\n"
            "\timageSize: %d\n"
-           "\twidthStep: %d\n",
+           "\timageData: %x\n"
+           "\twidthStep: %d\n"
+           "\timageDataOrigin: %x\n",
            image->nSize, image->ID, image->nChannels, image->alphaChannel,
            image->depth, image->dataOrder, image->origin, image->align,
-           image->width, image->height, image->imageSize, image->widthStep);
+           image->width, image->height, image->imageSize, (int)image->imageData, 
+           image->widthStep, (int)image->imageDataOrigin);
 }
 
 /****************************************************************************/
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 8592030..0473681 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -1,51 +1,54 @@
+{-# LANGUAGE ExistentialQuantification, Rank2Types, BangPatterns #-}
 -- |High-level Haskell bindings to OpenCV operations. Some of
 -- these operations are fusable under composition. For example,
 -- @dilate 8 . erode 8@ will allocate one new image rather than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, convertColor) 
+                            LineType(..), RGB, drawLines, convertColor,
+                           unsafeDrawLines) 
     where
 import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HIplImage
+import Control.Monad.ST (ST, runST, unsafeIOToST)
 import Foreign.Ptr
 import Foreign.Storable
-import System.IO.Unsafe
 
-{-# NOINLINE erode #-}
+newtype ImageProc = ImageProc { unProc :: HIplImage -> forall s. ST s HIplImage }
+
+runProc :: ImageProc -> HIplImage -> HIplImage
+runProc x img = runST $ unProc x img
+
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 erode :: Int -> HIplImage -> HIplImage
-erode n img = unsafePerformIO $
+erode n = runProc . ImageProc $ \img -> unsafeIOToST $
               withHIplImage img (\src -> return . withCompatibleImage img $
                                          \dst -> cvErode src dst n')
     where n' = fromIntegral n
 
-{-# NOINLINE dilate #-}
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 dilate :: Int -> HIplImage -> HIplImage
-dilate n img = unsafePerformIO $
+dilate n = runProc . ImageProc $ \img -> unsafeIOToST $
                withHIplImage img (\src -> return . withCompatibleImage img $
                                           \dst -> cvDilate src dst n')
     where n' = fromIntegral n
 
-{-# NOINLINE unsafeErode #-}
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the fusion rewrite rules when there is
 -- no way to observe the input image.
 unsafeErode :: Int -> HIplImage -> HIplImage
-unsafeErode n img = unsafePerformIO $ 
+unsafeErode n img = runST $ unsafeIOToST $ 
                     withHIplImage img (\src -> cvErode src src n') >> 
                     return img
     where n' = fromIntegral n
 
-{-# NOINLINE unsafeDilate #-}
 -- |Unsafe in-place dilation. This is a destructive update of the
 -- given image and is only used by the fusion rewrite rules when
 -- there is no way to observe the input image.
 unsafeDilate :: Int -> HIplImage -> HIplImage
-unsafeDilate n img = unsafePerformIO $
+unsafeDilate n = runProc . ImageProc $ \img -> unsafeIOToST $
                      withHIplImage img (\src -> cvDilate src src n') >> 
                      return img
     where n' = fromIntegral n
@@ -56,10 +59,9 @@ unsafeDilate n img = unsafePerformIO $
 "dilate-in-place" forall n f. dilate n . f = unsafeDilate n . f
   #-}
 
-{-# NOINLINE houghStandard #-}
 -- |Line detection in a binary image using a standard Hough transform.
 houghStandard :: Double -> Double -> Int -> HIplImage -> [((Int, Int),(Int,Int))]
-houghStandard rho theta threshold img = unsafePerformIO $
+houghStandard rho theta threshold img = runST $ unsafeIOToST $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        cvSeq <- withHIplImage img $ 
                 \p -> cvHoughLines2 p storage 0 rho theta threshold 0 0
@@ -82,28 +84,27 @@ houghStandard rho theta threshold img = unsafePerformIO $
           clampX x = max 0 (min (truncate x) (width img - 1))
           clampY y = max 0 (min (truncate y) (height img - 1))
 
-{-# NOINLINE houghProbabilistic #-}
 -- |Line detection in a binary image using a probabilistic Hough transform.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
                       HIplImage -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
-    unsafePerformIO $ do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
-                         cvSeq <- withHIplImage img $
-                                  \p -> cvHoughLines2 p storage 1 rho theta 
-                                                      threshold minLength 
-                                                      maxGap
-                         hlines <- mapM (\p1 -> do x1 <- peek p1
-                                                   let p2 = plusPtr p1 step
-                                                       p3 = plusPtr p2 step
-                                                       p4 = plusPtr p3 step
-                                                   y1 <- peek p2
-                                                   x2 <- peek p3
-                                                   y2 <- peek p4
-                                                   return ((x1,y1),(x2,y2)))
-                                         =<< seqToPList cvSeq
-                         cvReleaseMemStorage storage
-                         return hlines
-        where step = sizeOf (undefined::Int)
+    runST $ unsafeIOToST $
+    do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
+       cvSeq <- withHIplImage img $
+                \p -> cvHoughLines2 p storage 1 rho theta threshold minLength 
+                                    maxGap
+       hlines <- mapM (\p1 -> do x1 <- peek p1
+                                 let p2 = plusPtr p1 step
+                                     p3 = plusPtr p2 step
+                                     p4 = plusPtr p3 step
+                                 y1 <- peek p2
+                                 x2 <- peek p3
+                                 y2 <- peek p4
+                                 return ((x1,y1),(x2,y2)))
+                      =<< seqToPList cvSeq
+       cvReleaseMemStorage storage
+       return hlines
+    where step = sizeOf (undefined::Int)
 
 -- |Type of line to draw.
 data LineType = EightConn -- ^8-connected line
@@ -129,25 +130,24 @@ drawLines col thick lineType lines img =
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 
-{-# NOINLINE unsafeDrawLines #-}
 -- |Unsafe in-place line drawing.
 unsafeDrawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
                    HIplImage -> HIplImage
 unsafeDrawLines col thick lineType lines img = 
-    unsafePerformIO $
+    runST $ unsafeIOToST $
     withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return img
-    where lineType' = lineTypeEnum lineType
-          draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
+    where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
+          lineType' = lineTypeEnum lineType
+          
 
 {-# RULES
   "draw-lines-in-place" forall c t lt lns f. 
   drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
   #-}
 
-{-# NOINLINE convertColor #-}
 -- |Convert the color model of an image.
 convertColor :: ColorConversion -> HIplImage -> HIplImage
-convertColor cc img = unsafePerformIO $ 
+convertColor cc img = runST $ unsafeIOToST $ 
                       withHIplImage img $
                       \src -> do dst <- mkHIplImage w h nc
                                  withHIplImage dst $
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index 7458ef0..a9bbe5d 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -33,12 +33,15 @@ cvLoadImage fileName col = withCString fileName $
                            \str -> c_cvLoadImage str col'
     where col' = fromIntegral $ fromEnum col
 
-foreign import ccall unsafe "highgui.h cvSaveImage"
-  c_cvSaveImage :: CString -> Ptr CvArr -> IO ()
+foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header"
+  c_debug_ipl :: Ptr IplImage -> IO ()
+
+foreign import ccall safe "highgui.h cvSaveImage"
+  c_cvSaveImage :: CString -> Ptr CvArr -> Ptr Int -> IO ()
 
 cvSaveImage :: IplArrayType a => String -> Ptr a -> IO ()
 cvSaveImage fileName img = withCString fileName $
-                           \str -> c_cvSaveImage str (fromArr img)
+                           \str -> c_cvSaveImage str (fromArr img) nullPtr
 
 ------------------------------------------------
 -- Capturing

From a6bca8d249a66bff90d7dab948034d18e070ea3a Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 3 Aug 2010 21:10:53 -0400
Subject: [PATCH 013/137] Removed export of unsafeDrawLines.

Added a note about the current state of the unsafe operation fusion
rules.
---
 src/AI/CV/OpenCV/HighCV.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 0473681..567f3c5 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -3,8 +3,7 @@
 -- these operations are fusable under composition. For example,
 -- @dilate 8 . erode 8@ will allocate one new image rather than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, convertColor,
-                           unsafeDrawLines) 
+                            LineType(..), RGB, drawLines, convertColor) 
     where
 import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
@@ -54,6 +53,15 @@ unsafeDilate n = runProc . ImageProc $ \img -> unsafeIOToST $
     where n' = fromIntegral n
 
 -- Perform destructive in-place updates when such a change is safe.
+
+-- FIXME: These are not correct. Note that if the function f is, for
+-- example, the identity function, then we clobber the existing
+-- HIplImage. There needs to be a constraint that f is a function that
+-- allocates a fresh HIplImage. Perhaps this can be indicated with a
+-- type if all other HIplImage operations are implemented on a type
+-- class, then functions that generate new images can return an
+-- instance of that class that indicates a fresh image.
+
 {-# RULES 
 "erode-in-place"  forall n f. erode n . f = unsafeErode n . f
 "dilate-in-place" forall n f. dilate n . f = unsafeDilate n . f

From c8c85bd441ce729c1e9151b36dcd8a4537c71900 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 3 Aug 2010 22:19:41 -0400
Subject: [PATCH 014/137] Changed to using a type annotation to indicate image
 allocation.

The intent is that we will sometimes perform in-place updates when
composing an operation with a function whose return type explicitly
indicates that it is returning a fresh image. This gets around the
issue of fully parametric types like the identity function getting
picked up for allocation fusion.
---
 src/AI/CV/OpenCV/HIplImage.hsc | 76 +++++++++++++-------------
 src/AI/CV/OpenCV/HighCV.hs     | 97 ++++++++++++++++------------------
 src/AI/CV/OpenCV/PixelUtils.hs |  8 +--
 3 files changed, 87 insertions(+), 94 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index ef18284..0c7011e 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,5 +1,9 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-module AI.CV.OpenCV.HIplImage where
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
+module AI.CV.OpenCV.HIplImage 
+    ( HIplImage, FreshImage, numChannels, width, height, imageSize, widthStep, 
+      pixels, pixels16, fromPtr, fromFile, toFile, fromPixels, withHIplImage, 
+      withCompatibleImage, withDuplicateImage, mkHIplImage )
+    where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
 import Control.Applicative ((<$>))
@@ -12,6 +16,7 @@ import Foreign.Marshal.Alloc (alloca)
 import Foreign.Marshal.Array (copyArray)
 import Foreign.Ptr
 import Foreign.Storable
+import Unsafe.Coerce
 
 #include <opencv/cxtypes.h>
 {-
@@ -43,23 +48,24 @@ typedef struct _IplImage
 IplImage;
 -}
 
+data FreshImage
+
 -- |A Haskell data structure representing the information OpenCV uses
 -- from an 'IplImage' struct.
-data HIplImage = HIplImage { numChannels     :: Int
-                           , depth           :: Depth
-                           , dataOrder       :: Int
-                           , origin          :: Int
-                           , width           :: Int
-                           , height          :: Int
-                           , imageSize       :: Int
-                           , imageData       :: ForeignPtr Word8
-                           , widthStep       :: Int
-                           , imageDataOrigin :: ForeignPtr Word8 }
+data HIplImage a = HIplImage { numChannels     :: Int
+                             , depth           :: Depth
+                             , dataOrder       :: Int
+                             , origin          :: Int
+                             , width           :: Int
+                             , height          :: Int
+                             , imageSize       :: Int
+                             , imageData       :: ForeignPtr Word8
+                             , widthStep       :: Int }
 
 -- |Return a 'V.Vector' containing the pixels that make up an
 -- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
 -- data!
-pixels :: HIplImage -> V.Vector Word8
+pixels :: HIplImage a -> V.Vector Word8
 pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
     where ptr = case depth img of
                   Depth 8 -> imageData img
@@ -68,7 +74,7 @@ pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
 
 -- |Return a 'V.Vector' containing the pixels that make up the
 -- 16-bit-per-pixel 'HIplImage'.
-pixels16 :: HIplImage -> V.Vector Word16
+pixels16 :: HIplImage a -> V.Vector Word16
 pixels16 img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
     where ptr = case depth img of
                   Depth 16 -> castForeignPtr (imageData img)
@@ -76,21 +82,21 @@ pixels16 img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
                                " is not supported"
 
 -- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: Ptr IplImage -> IO HIplImage
+fromPtr :: Ptr IplImage -> IO (HIplImage ())
 fromPtr = peek . castPtr
 
 -- |Load an 'HIplImage' from an image file on disk. The first argument
 -- is the name of the file to load. The second argument determines
 -- the desired color format of the image.
-fromFile :: String -> LoadColor -> IO HIplImage
-fromFile fileName col = fromPtr =<< cvLoadImage fileName col
+fromFile :: String -> LoadColor -> IO (HIplImage FreshImage)
+fromFile fileName col = unsafeCoerce . fromPtr =<< cvLoadImage fileName col
 
-toFile :: String -> HIplImage -> IO ()
+toFile :: String -> HIplImage a -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 -- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
 -- and number of color channels with an allocated pixel buffer.
-mkHIplImage :: Int -> Int -> Int -> IO HIplImage
+mkHIplImage :: Int -> Int -> Int -> IO (HIplImage FreshImage)
 mkHIplImage w h numChan = 
     -- do fp <- createImageF (CvSize w' h') numChan' iplDepth8u
     --    withForeignPtr fp $ \p -> peek (castPtr p)
@@ -98,17 +104,17 @@ mkHIplImage w h numChan =
     --       h' = fromIntegral h
     --       numChan' = fromIntegral numChan
     do ptr <- mallocForeignPtrArray numBytes
-       return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride ptr
+       return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride
     where numBytes = stride * h
           stride = w * numChan
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
-compatibleImage :: HIplImage -> IO HIplImage
+compatibleImage :: HIplImage a -> IO (HIplImage FreshImage)
 compatibleImage img = 
     do ptr <- mallocForeignPtrArray sz
-       return $ HIplImage nc d order 0 w h sz ptr stride ptr
+       return $ HIplImage nc d order 0 w h sz ptr stride
     where w = width img
           h = height img
           nc = numChannels img
@@ -119,12 +125,12 @@ compatibleImage img =
 
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
-duplicateImage :: HIplImage -> IO HIplImage
+duplicateImage :: HIplImage a -> IO (HIplImage FreshImage)
 duplicateImage img =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
            \src -> withForeignPtr fptr $ \dst -> copyArray dst src sz
-       return $ HIplImage nc d 0 0 w h sz fptr stride fptr
+       return $ HIplImage nc d 0 0 w h sz fptr stride
     where w = width img
           h = height img
           nc = numChannels img
@@ -135,14 +141,9 @@ duplicateImage img =
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
 -- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
 -- with the supplied 'V.Vector'.
-fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage
--- fromPixels w h pix = runST $ unsafeIOToST $ 
---                      V.unsafeWith pix $
---                          \p -> do fp <- newForeignPtr_ p
---                                   return $ HIplImage nc iplDepth8u 0 0 w' h'
---                                                      sz fp stride fp
+fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage ()
 fromPixels w h pix = if fromIntegral len == sz 
-                     then HIplImage nc iplDepth8u 0 0 w' h' sz fp stride fp
+                     then HIplImage nc iplDepth8u 0 0 w' h' sz fp stride
                      else error "Length disagreement"
     where nc = if V.length pix == w' * h' then 1 else 3
           w' = fromIntegral w
@@ -155,7 +156,7 @@ fromPixels w h pix = if fromIntegral len == sz
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
-withHIplImage :: HIplImage -> (Ptr IplImage -> IO a) -> IO a
+withHIplImage :: HIplImage a -> (Ptr IplImage -> IO b) -> IO b
 --withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
@@ -165,7 +166,7 @@ withHIplImage img f = alloca $
 -- Poke a 'Ptr' 'HIplImage' with a specific imageData 'Ptr' that is
 -- currently valid. This is solely an auxiliary function to
 -- 'withHIplImage'.
-pokeIpl :: HIplImage -> Ptr HIplImage -> Ptr Word8 -> IO ()
+pokeIpl :: HIplImage a -> Ptr (HIplImage a) -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
     do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
        (#poke IplImage, ID) ptr (0::Int)
@@ -188,7 +189,7 @@ pokeIpl himg ptr hp =
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'.
-withDuplicateImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
+withDuplicateImage :: HIplImage a -> (Ptr IplImage -> IO b) -> HIplImage FreshImage
 withDuplicateImage img1 f = runST $ unsafeIOToST $
                             do img2 <- duplicateImage img1
                                _ <- withHIplImage img2 f
@@ -197,7 +198,7 @@ withDuplicateImage img1 f = runST $ unsafeIOToST $
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
-withCompatibleImage :: HIplImage -> (Ptr IplImage -> IO a) -> HIplImage
+withCompatibleImage :: HIplImage a -> (Ptr IplImage -> IO b) -> HIplImage FreshImage
 withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
                                 _ <- withHIplImage img2 f
@@ -213,7 +214,7 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
 -- values constructed within the Haskell runtime, on the other hand,
 -- do have their underlying pixel data buffers registered with a
 -- finalizer.
-instance Storable HIplImage where
+instance Storable (HIplImage a) where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
@@ -245,11 +246,8 @@ instance Storable HIplImage where
       imageSize' <- (#peek IplImage, imageSize) ptr
       imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
       widthStep' <- (#peek IplImage, widthStep) ptr
-      imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= 
-                          newForeignPtr_
       return $ HIplImage numChannels' depth' dataOrder' origin' 
                          width' height' imageSize' imageData' widthStep' 
-                         imageDataOrigin'
 
 
 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 567f3c5..488adbd 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE ExistentialQuantification, Rank2Types, BangPatterns #-}
--- |High-level Haskell bindings to OpenCV operations. Some of
--- these operations are fusable under composition. For example,
--- @dilate 8 . erode 8@ will allocate one new image rather than two.
+-- |High-level Haskell bindings to OpenCV operations. Some of these
+-- operations will be performed in-place under composition. For
+-- example, @dilate 8 . erode 8@ will allocate one new image rather
+-- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
                             LineType(..), RGB, drawLines, convertColor) 
     where
@@ -9,66 +9,62 @@ import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HIplImage
-import Control.Monad.ST (ST, runST, unsafeIOToST)
+import Control.Monad.ST (runST, unsafeIOToST)
 import Foreign.Ptr
 import Foreign.Storable
-
-newtype ImageProc = ImageProc { unProc :: HIplImage -> forall s. ST s HIplImage }
-
-runProc :: ImageProc -> HIplImage -> HIplImage
-runProc x img = runST $ unProc x img
+import Unsafe.Coerce
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: Int -> HIplImage -> HIplImage
-erode n = runProc . ImageProc $ \img -> unsafeIOToST $
-              withHIplImage img (\src -> return . withCompatibleImage img $
-                                         \dst -> cvErode src dst n')
+erode :: Int -> HIplImage a -> HIplImage FreshImage
+erode n img = runST $
+              unsafeIOToST . withHIplImage img $
+              \src -> return . withCompatibleImage img $
+                      \dst -> cvErode src dst n'
     where n' = fromIntegral n
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: Int -> HIplImage -> HIplImage
-dilate n = runProc . ImageProc $ \img -> unsafeIOToST $
-               withHIplImage img (\src -> return . withCompatibleImage img $
-                                          \dst -> cvDilate src dst n')
+dilate :: Int -> HIplImage a -> HIplImage FreshImage
+dilate n img = runST $ 
+               unsafeIOToST . withHIplImage img $
+               \src -> return . withCompatibleImage img $
+                       \dst -> cvDilate src dst n'
     where n' = fromIntegral n
 
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the fusion rewrite rules when there is
 -- no way to observe the input image.
-unsafeErode :: Int -> HIplImage -> HIplImage
-unsafeErode n img = runST $ unsafeIOToST $ 
-                    withHIplImage img (\src -> cvErode src src n') >> 
-                    return img
+unsafeErode :: Int -> HIplImage a -> HIplImage FreshImage
+unsafeErode n img = runST $ 
+                    unsafeIOToST $
+                        withHIplImage img (\src -> cvErode src src n') >> 
+                        return (unsafeCoerce img)
     where n' = fromIntegral n
 
 -- |Unsafe in-place dilation. This is a destructive update of the
 -- given image and is only used by the fusion rewrite rules when
 -- there is no way to observe the input image.
-unsafeDilate :: Int -> HIplImage -> HIplImage
-unsafeDilate n = runProc . ImageProc $ \img -> unsafeIOToST $
-                     withHIplImage img (\src -> cvDilate src src n') >> 
-                     return img
+unsafeDilate :: Int -> HIplImage a -> HIplImage FreshImage
+unsafeDilate n img = runST $ 
+                     unsafeIOToST $
+                         withHIplImage img (\src -> cvDilate src src n') >> 
+                         return (unsafeCoerce img)
     where n' = fromIntegral n
 
--- Perform destructive in-place updates when such a change is safe.
-
--- FIXME: These are not correct. Note that if the function f is, for
--- example, the identity function, then we clobber the existing
--- HIplImage. There needs to be a constraint that f is a function that
--- allocates a fresh HIplImage. Perhaps this can be indicated with a
--- type if all other HIplImage operations are implemented on a type
--- class, then functions that generate new images can return an
--- instance of that class that indicates a fresh image.
+-- Perform destructive in-place updates when such a change is
+-- safe. Safety is indicated by the phantom type tag annotating
+-- HIplImage. If we have a function yielding an HIplImage FreshImage,
+-- then we can clobber it. That is the *only* time these in-place
+-- operations are known to be safe.
 
 {-# RULES 
-"erode-in-place"  forall n f. erode n . f = unsafeErode n . f
-"dilate-in-place" forall n f. dilate n . f = unsafeDilate n . f
+"erode-in-place"  forall n (f::a->HIplImage FreshImage). erode n . f = unsafeErode n . f
+"dilate-in-place" forall n (f::a->HIplImage FreshImage). dilate n . f = unsafeDilate n . f
   #-}
 
 -- |Line detection in a binary image using a standard Hough transform.
-houghStandard :: Double -> Double -> Int -> HIplImage -> [((Int, Int),(Int,Int))]
+houghStandard :: Double -> Double -> Int -> HIplImage a -> [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = runST $ unsafeIOToST $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        cvSeq <- withHIplImage img $ 
@@ -94,7 +90,7 @@ houghStandard rho theta threshold img = runST $ unsafeIOToST $
 
 -- |Line detection in a binary image using a probabilistic Hough transform.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage -> [((Int, Int),(Int,Int))]
+                      HIplImage a -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     runST $ unsafeIOToST $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -131,8 +127,8 @@ lineTypeEnum AALine    = 16
 -- |Draw each line, defined by its endpoints, on a duplicate of the
 -- given 'HIplImage' using the specified RGB color, line thickness,
 -- and aliasing style. This function is fusible under composition.
-drawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> HIplImage -> 
-             HIplImage
+drawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
+             HIplImage a -> HIplImage FreshImage
 drawLines col thick lineType lines img = 
     withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
@@ -140,27 +136,26 @@ drawLines col thick lineType lines img =
 
 -- |Unsafe in-place line drawing.
 unsafeDrawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-                   HIplImage -> HIplImage
+                   HIplImage a -> HIplImage FreshImage
 unsafeDrawLines col thick lineType lines img = 
     runST $ unsafeIOToST $
-    withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return img
+    withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return (unsafeCoerce img)
     where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
-          
 
 {-# RULES
-  "draw-lines-in-place" forall c t lt lns f. 
+  "draw-lines-in-place" forall c t lt lns (f::a->HIplImage FreshImage). 
   drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
   #-}
 
 -- |Convert the color model of an image.
-convertColor :: ColorConversion -> HIplImage -> HIplImage
+convertColor :: ColorConversion -> HIplImage a -> HIplImage FreshImage
 convertColor cc img = runST $ unsafeIOToST $ 
-                      withHIplImage img $
-                      \src -> do dst <- mkHIplImage w h nc
-                                 withHIplImage dst $
-                                   \dst' -> cvCvtColor src dst' cc
-                                 return dst
+                       withHIplImage img $
+                       \src -> do dst <- mkHIplImage w h nc
+                                  withHIplImage dst $
+                                    \dst' -> cvCvtColor src dst' cc
+                                  return dst
     where w = width img
           h = height img
           destChannels = [(cv_RGB2BGR, 3), (cv_BGR2GRAY, 1), (cv_GRAY2BGR, 3)]
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 63271c2..12caa90 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -22,7 +22,7 @@ rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
 
 -- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded rows
 -- to tightly packed rows of RGB pixels.
-toRGB :: HIplImage -> V.Vector Word8
+toRGB :: HIplImage a -> V.Vector Word8
 toRGB img = V.backpermute (pixels img) $
             rgbIndices (width img) (widthStep img) (imageSize img)
 
@@ -30,7 +30,7 @@ toRGB img = V.backpermute (pixels img) $
 -- rows to tightly packed rows of RGB pixels using the given
 -- 'V.Vector' of indices. The index 'Vector' will typically be the
 -- result of a previous call to 'rgbIndices'.
-toRGB' :: HIplImage -> V.Vector Int -> V.Vector Word8
+toRGB' :: HIplImage a -> V.Vector Int -> V.Vector Word8
 toRGB' img inds = V.backpermute (pixels img) inds
 
 -- |Drop any pixels beyond real image data on each row.
@@ -41,7 +41,7 @@ dropAlpha w = V.ifilter (\i _ -> (i `rem` rowLength) < realWidth)
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: Int -> HIplImage -> V.Vector Word8
+isolateChannel :: Int -> HIplImage a -> V.Vector Word8
 isolateChannel ch img = 
     if ch >= 3 || numCh /= 3
     then error $ "Invalid channel "++show ch++" for image with "++show numCh++
@@ -61,7 +61,7 @@ isolateChannel ch img =
           get = V.unsafeIndex pix
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: HIplImage -> V.Vector Word8
+toMono :: HIplImage a -> V.Vector Word8
 toMono img = if numChannels img == 1 then dropAlpha w pix 
              else runST $ do v <- VM.new (w*h)
                              let go !x !p !p3 !y

From 32e3201f3d5b5ec379be3d6576227c574e09038c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 3 Aug 2010 22:22:24 -0400
Subject: [PATCH 015/137] Added comment for the FreshImage type tag.

---
 src/AI/CV/OpenCV/HIplImage.hsc | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 0c7011e..925710d 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -48,6 +48,10 @@ typedef struct _IplImage
 IplImage;
 -}
 
+-- |Type annotation indicating that an 'HIplImage' is freshly
+-- allocated. This is used to drive the allocation fusion mechanism
+-- that may perform in-place updates when an operation is composed
+-- with a function that returns a fresh image.
 data FreshImage
 
 -- |A Haskell data structure representing the information OpenCV uses

From 7a31aceb2c966ac1427e60600085274f42a4a616 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 4 Aug 2010 17:39:19 -0400
Subject: [PATCH 016/137] Added copying conversions between HIplImage and
 Vector.

Added a bit of HIplImage to the export list of HighCV in the hope
that HighCV can be the sole entrypoint to the library for a typical
client.
---
 src/AI/CV/OpenCV/HIplImage.hsc | 41 ++++++++++++++++++++++++++++++----
 src/AI/CV/OpenCV/HighCV.hs     |  4 +++-
 2 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 925710d..e1184f1 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,8 +1,9 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
 module AI.CV.OpenCV.HIplImage 
     ( HIplImage, FreshImage, numChannels, width, height, imageSize, widthStep, 
-      pixels, pixels16, fromPtr, fromFile, toFile, fromPixels, withHIplImage, 
-      withCompatibleImage, withDuplicateImage, mkHIplImage )
+      pixels, pixelsCopy, pixels16, fromPtr, fromFile, toFile, fromPixels, 
+      fromPixelsCopy, withHIplImage, withCompatibleImage, withDuplicateImage, 
+      mkHIplImage )
     where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
@@ -13,7 +14,7 @@ import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Array (copyArray)
+import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr
 import Foreign.Storable
 import Unsafe.Coerce
@@ -76,6 +77,20 @@ pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
                   x -> error $ "Pixel depth must be 8, "++show x++
                                " is not supported"
 
+doST :: IO a -> a
+doST x = runST (unsafeIOToST x)
+
+-- |Return a 'V.Vector' containing the pixels that make up an
+-- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
+-- pixel data.
+pixelsCopy :: HIplImage a -> V.Vector Word8
+pixelsCopy img = doST $ do ptr <- mallocForeignPtrBytes len
+                           withForeignPtr ptr $
+                              \dst -> withForeignPtr (imageData img) $
+                                        \src -> copyBytes dst src len
+                           return $ V.unsafeFromForeignPtr ptr 0 (imageSize img)
+    where len = imageSize img
+
 -- |Return a 'V.Vector' containing the pixels that make up the
 -- 16-bit-per-pixel 'HIplImage'.
 pixels16 :: HIplImage a -> V.Vector Word16
@@ -133,7 +148,7 @@ duplicateImage :: HIplImage a -> IO (HIplImage FreshImage)
 duplicateImage img =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
-           \src -> withForeignPtr fptr $ \dst -> copyArray dst src sz
+           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
        return $ HIplImage nc d 0 0 w h sz fptr stride
     where w = width img
           h = height img
@@ -158,6 +173,24 @@ fromPixels w h pix = if fromIntegral len == sz
                          (fp,0,len) -> (fp,len)
                          _ -> error "fromPixels non-zero offset"
 
+-- |Construct a fresh 'HIplImage' from a width, a height, and a
+-- 'V.Vector' of 8-bit pixel values.
+fromPixelsCopy :: Integral a => a -> a -> V.Vector Word8 -> HIplImage FreshImage
+fromPixelsCopy w h pix = 
+    doST $ do fp <- copyData
+              return $ HIplImage nc iplDepth8u 0 0 w' h' sz fp stride
+    where nc = if V.length pix == w' * h' then 1 else 3
+          w' = fromIntegral w
+          h' = fromIntegral h
+          sz = w' * h' * nc
+          stride = w' * nc
+          copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
+                     in do fp <- mallocForeignPtrBytes len
+                           withForeignPtr vfp $
+                             \src -> withForeignPtr fp $
+                                       \dst -> copyBytes dst src len
+                           return fp
+
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: HIplImage a -> (Ptr IplImage -> IO b) -> IO b
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 488adbd..0c96673 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -3,7 +3,9 @@
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, convertColor) 
+                            LineType(..), RGB, drawLines, convertColor, 
+                            HIplImage, width, height, numChannels, pixels, 
+                            fromPixels, fromFile, toFile) 
     where
 import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore

From 8d86a367ac7ccca8904cf93658daac9228db2f50 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 5 Aug 2010 11:02:02 -0400
Subject: [PATCH 017/137] Added initial support for cvFindContours.

---
 src/AI/CV/OpenCV/CV.hsc         | 78 ++++++++++++++++++++++++++++++++-
 src/AI/CV/OpenCV/CxCore.hsc     | 15 +++++++
 src/AI/CV/OpenCV/HOpenCV_wrap.c |  9 ++++
 src/AI/CV/OpenCV/HOpenCV_wrap.h |  4 ++
 4 files changed, 105 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index 5af38d1..2dea0e6 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -7,10 +7,12 @@ module AI.CV.OpenCV.CV
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
       combineHaarFlags, cvHaarDetectObjects,
-      cvCvtColor
+      cvCvtColor, cvFindContours
     ) where
 
 import Foreign.C.Types
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (poke)
 import Foreign.Ptr
 import Data.Bits
 import AI.CV.OpenCV.CxCore
@@ -80,6 +82,80 @@ cvCvtColor :: (IplArrayType a, IplArrayType b) =>
               Ptr a -> Ptr b -> ColorConversion -> IO ()
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
+
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
+  c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> Int -> Int -> Int -> Int -> Int -> IO Int
+
+-- |Contour extraction mode.
+data ContourMode = CV_RETR_EXTERNAL -- ^retrives only the extreme
+                                    -- outer contours
+
+                 | CV_RETR_LIST     -- ^retrieves all of the contours
+                                    -- and puts them in the list
+
+                 | CV_RETR_CCOMP    -- ^retrieves all of the contours
+                                    -- and organizes them into a
+                                    -- two-level hierarchy: on the top
+                                    -- level are the external
+                                    -- boundaries of the components,
+                                    -- on the second level are the
+                                    -- boundaries of the holes
+
+                 | CV_RETR_TREE     -- ^retrieves all of the contours
+                                    -- and reconstructs the full
+                                    -- hierarchy of nested contours
+                   deriving (Enum, Eq)
+
+data ContourMethod = CV_CHAIN_APPROX_NONE      
+                   -- ^translates all of the points from the chain
+                   -- code into points
+
+                   | CV_CHAIN_APPROX_SIMPLE    
+                   -- ^compresses horizontal, vertical, and diagonal
+                   -- segments and leaves only their end points
+
+                   | CV_CHAIN_APPROX_TC89_L1   
+                   -- ^applies one of the flavors of the Teh-Chin
+                   -- chain approximation algorithm
+
+                   | CV_CHAIN_APPROX_TC89_KCOS
+                   -- ^applies one of the flavors of the Teh-Chin
+                   -- chain approximation algorithm
+
+                   | CV_LINK_RUNS
+                   -- ^uses a completely different contour retrieval
+                   -- algorithm by linking horizontal segments of
+                   -- 1's. Only the CV_RETR_LIST retrieval mode can be
+                   -- used with this method.  
+
+                   -- | CV_CHAIN_CODE -- changes returned sequence type
+                     deriving Enum
+
+-- |The function retrieves 'CvContour's from the binary image using the
+-- algorithm Suzuki85 . The contours are a useful tool for shape
+-- analysis and object detection and recognition.
+cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour]
+cvFindContours img mode method = 
+    do storage <- cvCreateMemStorage 0
+       let header = case method of
+                      --CV_CHAIN_CODE -> (#size CvChain)
+                      _ -> (#size CvContour)
+           mode' = fromEnum mode
+           method' = case method of 
+                       CV_LINK_RUNS -> if mode == CV_RETR_LIST
+                                       then fromEnum method
+                                       else error $ "CV_LINK_RUNS can only be "++
+                                                    "used with CV_RETR_LIST"
+                       _ -> fromEnum method
+       cs <- alloca $ \cseq ->
+               do _n <- alloca $ \cseq' ->
+                          poke (cseq'::Ptr (Ptr CInt)) cseq >>
+                          c_cvFindContours (fromArr img) storage (castPtr cseq')
+                                           header mode' method' 0 0
+                  seqToList (castPtr cseq)
+       cvReleaseMemStorage storage
+       return cs
+
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index 4d63873..5b94f45 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -88,6 +88,21 @@ instance VectorSpace CvRect where
   type Scalar CvRect = Double -- todo: use CInt instead of Double here?
   a *^ r = liftCvRect (a*) r
 
+------------------------------------------------------
+-- |A 'CvContour' has a bounding 'CvRect' and a color.
+data CvContour = CvContour CvRect Int
+
+instance Storable CvContour where
+    sizeOf _ = (#size CvContour)
+    alignment _ = alignment (undefined::CDouble)
+    peek ptr = do
+      rect <- (#peek CvContour, rect) ptr
+      color <- (#peek CvContour, color) ptr
+      return $ CvContour rect color
+    poke ptr (CvContour r c) = do
+      (#poke CvContour, rect) ptr r
+      (#poke CvContour, color) ptr c
+
 ------------------------------------------------------
 class IplArrayType a
 
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c
index 4adcd50..1d88946 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c
@@ -143,6 +143,15 @@ void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g,
            lineType, shift);
 }
 
+int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, 
+                     int header_size, int mode, int method, int offset_x, 
+                     int offset_y)
+{
+    return cvFindContours(img, storage, first_contour, header_size, mode, 
+                          method, cvPoint(offset_x,offset_y));
+}
+
+
 
 /****************************************************************************/
 
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/HOpenCV_wrap.h
index 41a9bfc..b44cc10 100644
--- a/src/AI/CV/OpenCV/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/HOpenCV_wrap.h
@@ -30,6 +30,10 @@ void c_cvRectangle(CvArr *img, int x, int y, int width, int height);
 void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
               double b, int thickness, int lineType, int shift);
 
+int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, 
+                     int header_size, int mode, int method, int offset_x, 
+                     int offset_y);
+
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,

From ace3a932e5ec9c0b5699a8a03e4c0093b236df1a Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 5 Aug 2010 11:57:36 -0400
Subject: [PATCH 018/137] Working on Contour extraction. Not done yet.

---
 src/AI/CV/OpenCV/CV.hsc        | 26 +++++++++++++++++++++-----
 src/AI/CV/OpenCV/CxCore.hsc    |  2 +-
 src/AI/CV/OpenCV/HIplImage.hsc | 16 +++++++++++++---
 src/AI/CV/OpenCV/HighCV.hs     |  9 +++++++--
 4 files changed, 42 insertions(+), 11 deletions(-)

diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index 2dea0e6..b9416b9 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -7,12 +7,12 @@ module AI.CV.OpenCV.CV
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
       combineHaarFlags, cvHaarDetectObjects,
-      cvCvtColor, cvFindContours
+      cvCvtColor, cvFindContours, ContourMethod(..), ContourMode(..)
     ) where
 
 import Foreign.C.Types
 import Foreign.Marshal.Alloc (alloca)
-import Foreign.Storable (poke)
+import Foreign.Storable (poke, peek, peekByteOff)
 import Foreign.Ptr
 import Data.Bits
 import AI.CV.OpenCV.CxCore
@@ -87,7 +87,7 @@ foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
   c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> Int -> Int -> Int -> Int -> Int -> IO Int
 
 -- |Contour extraction mode.
-data ContourMode = CV_RETR_EXTERNAL -- ^retrives only the extreme
+data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme
                                     -- outer contours
 
                  | CV_RETR_LIST     -- ^retrieves all of the contours
@@ -132,7 +132,7 @@ data ContourMethod = CV_CHAIN_APPROX_NONE
                      deriving Enum
 
 -- |The function retrieves 'CvContour's from the binary image using the
--- algorithm Suzuki85 . The contours are a useful tool for shape
+-- algorithm Suzuki85. The contours are a useful tool for shape
 -- analysis and object detection and recognition.
 cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour]
 cvFindContours img mode method = 
@@ -152,10 +152,26 @@ cvFindContours img mode method =
                           poke (cseq'::Ptr (Ptr CInt)) cseq >>
                           c_cvFindContours (fromArr img) storage (castPtr cseq')
                                            header mode' method' 0 0
-                  seqToList (castPtr cseq)
+                  putStrLn $ "Found "++show _n++" contours"
+                  followContourList (castPtr cseq)
        cvReleaseMemStorage storage
        return cs
 
+-- FIXME: This is wrong. We're actually getting an array of arrays of
+-- Points. Check the cvDrawContours function to see how to interpret
+-- the result of c_cvFindContours.
+followContourList :: Ptr (CvSeq CvContour) -> IO [CvContour]
+followContourList = go []
+    where go acc p = if p == nullPtr
+                     then return $ reverse acc
+                     else do putStrLn "Getting element 1"
+                             n <- seqNumElems p
+                             putStrLn $ "Initial seq has "++show n++" elems"
+                             x <- peek =<< cvGetSeqElem p 1
+                             putStrLn $ "Found " ++ show x
+                             p' <- (#peek CvSeq, h_next) p
+                             go (x:acc) p'
+
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index 5b94f45..054f196 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -90,7 +90,7 @@ instance VectorSpace CvRect where
 
 ------------------------------------------------------
 -- |A 'CvContour' has a bounding 'CvRect' and a color.
-data CvContour = CvContour CvRect Int
+data CvContour = CvContour CvRect Int deriving (Show, Eq)
 
 instance Storable CvContour where
     sizeOf _ = (#size CvContour)
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index e1184f1..a1b4212 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -3,7 +3,7 @@ module AI.CV.OpenCV.HIplImage
     ( HIplImage, FreshImage, numChannels, width, height, imageSize, widthStep, 
       pixels, pixelsCopy, pixels16, fromPtr, fromFile, toFile, fromPixels, 
       fromPixelsCopy, withHIplImage, withCompatibleImage, withDuplicateImage, 
-      mkHIplImage )
+      mkHIplImage, withDuplicateImage')
     where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
@@ -188,7 +188,8 @@ fromPixelsCopy w h pix =
                      in do fp <- mallocForeignPtrBytes len
                            withForeignPtr vfp $
                              \src -> withForeignPtr fp $
-                                       \dst -> copyBytes dst src len
+                                       \dst -> let src' = plusPtr src offset
+                                               in copyBytes dst src' len
                            return fp
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
@@ -225,13 +226,22 @@ pokeIpl himg ptr hp =
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
--- given 'HIplImage'.
+-- given 'HIplImage'. Returns the duplicate 'HIplImage' after
+-- performing the given action
 withDuplicateImage :: HIplImage a -> (Ptr IplImage -> IO b) -> HIplImage FreshImage
 withDuplicateImage img1 f = runST $ unsafeIOToST $
                             do img2 <- duplicateImage img1
                                _ <- withHIplImage img2 f
                                return img2
 
+-- |Provides the supplied function with a 'Ptr' to an 'IplImage' that
+-- is a duplicate of the given 'HIplImage'. Returns the result of the
+-- given 'IO' action.
+withDuplicateImage' :: HIplImage a -> (Ptr IplImage -> IO b) -> b
+withDuplicateImage' img1 f = runST $ unsafeIOToST $
+                             do img2 <- duplicateImage img1
+                                withHIplImage img2 f
+
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 0c96673..a8c6cc6 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -5,7 +5,7 @@
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
                             LineType(..), RGB, drawLines, convertColor, 
                             HIplImage, width, height, numChannels, pixels, 
-                            fromPixels, fromFile, toFile) 
+                            fromPixels, fromFile, toFile, findContours) 
     where
 import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
@@ -164,4 +164,9 @@ convertColor cc img = runST $ unsafeIOToST $
           nc = case lookup cc destChannels of
                  Just n -> n
                  Nothing -> error $ "Unfamiliar color conversion. "++
-                                    "Contact maintainer."
\ No newline at end of file
+                                    "Contact maintainer."
+
+-- |Find the 'CvContour's in an image.
+findContours :: HIplImage a -> [CvContour]
+findContours img = withDuplicateImage' img $
+                     \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
\ No newline at end of file

From 3884e8aa8cddbfa5adeb754af0744bc6fe2ace8a Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 17:38:31 -0400
Subject: [PATCH 019/137] Statically typed color model of images.

The distinction between MonoChromatic and TriChromatic,
as well as 8bpp or 16bpp, can now be determined through types.
This makes various image processing procedures that, for example,
require a monochromatic 8bpp image safe to call.
---
 src/AI/CV/OpenCV/HIplImage.hsc | 273 ++++++++++++++++++++-------------
 src/AI/CV/OpenCV/HighCV.hs     |  98 +++++++-----
 src/AI/CV/OpenCV/PixelUtils.hs |  24 ++-
 3 files changed, 240 insertions(+), 155 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index a1b4212..495f249 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,13 +1,17 @@
-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
 module AI.CV.OpenCV.HIplImage 
-    ( HIplImage, FreshImage, numChannels, width, height, imageSize, widthStep, 
-      pixels, pixelsCopy, pixels16, fromPtr, fromFile, toFile, fromPixels, 
-      fromPixelsCopy, withHIplImage, withCompatibleImage, withDuplicateImage, 
-      mkHIplImage, withDuplicateImage')
+    ( HIplImage, FreshImage, TriChromatic, MonoChromatic, HasChannels,
+      HasDepth, width, height, imageSize, widthStep, pixels, pixelsCopy, 
+      fromPtr, fromFileColor, fromFileGray, toFile, fromGrayPixels, isColor,
+      fromColorPixels, withHIplImage, fromPixels, fromPixelsCopy,
+      imgChannels, withCompatibleImage, withDuplicateImage, mkHIplImage, isMono)
     where
-import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u)
-import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor)
+import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u)
+import AI.CV.OpenCV.CV (cvCvtColor)
+import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
+import AI.CV.OpenCV.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
+import Control.Monad (when)
 import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
@@ -55,27 +59,65 @@ IplImage;
 -- with a function that returns a fresh image.
 data FreshImage
 
+data TriChromatic
+data MonoChromatic
+
+class HasChannels a where
+    numChannels :: a -> Int
+
+class HasDepth a where
+    depth :: a -> Depth
+
+instance HasChannels TriChromatic where numChannels _ = 3
+instance HasChannels MonoChromatic where numChannels _ = 1
+instance HasDepth Word8 where depth _ = iplDepth8u
+instance HasDepth Word16 where depth _ = iplDepth16u
+
+bytesPerPixel :: Depth -> Int
+bytesPerPixel = (`div` 8) . fromIntegral . unDepth
+
 -- |A Haskell data structure representing the information OpenCV uses
 -- from an 'IplImage' struct.
-data HIplImage a = HIplImage { numChannels     :: Int
-                             , depth           :: Depth
-                             , dataOrder       :: Int
-                             , origin          :: Int
-                             , width           :: Int
-                             , height          :: Int
-                             , imageSize       :: Int
-                             , imageData       :: ForeignPtr Word8
-                             , widthStep       :: Int }
+{-
+data HIplImage a c d = HIplImage { origin          :: Int
+                                 , width           :: Int
+                                 , height          :: Int
+                                 , imageSize       :: Int
+                                 , imageData       :: ForeignPtr d
+                                 , widthStep       :: Int }
+-}
+data HIplImage a c d where
+    HIplImage :: (HasChannels c, HasDepth d, Storable d) => 
+                 Int -> Int -> Int -> Int -> ForeignPtr d -> Int -> 
+                 HIplImage a c d
+origin, width, height, imageSize, widthStep :: HIplImage a c d -> Int
+origin (HIplImage o _ _ _ _ _) = o
+width (HIplImage _ w _ _ _ _) = w
+height (HIplImage _ _ h _ _ _) = h
+imageSize (HIplImage _ _ _ s _ _) = s
+widthStep (HIplImage _ _ _ _ _ s) = s
+
+imageData :: HIplImage a c d -> ForeignPtr d
+imageData (HIplImage _ _ _ _ d _) = d
+
+-- |This is a way to let the type checker know that you belieave an
+-- image to be tri-chromatic.
+isColor :: HIplImage a TriChromatic d -> HIplImage a TriChromatic d
+isColor = id
+
+-- |This is a way to let the type checker know that you believe an
+-- image to be monochromatic.
+isMono :: HIplImage a MonoChromatic d -> HIplImage a MonoChromatic d
+isMono = id
+
+imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
+imgChannels _ = numChannels (undefined::c)
 
 -- |Return a 'V.Vector' containing the pixels that make up an
 -- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
 -- data!
-pixels :: HIplImage a -> V.Vector Word8
-pixels img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
-    where ptr = case depth img of
-                  Depth 8 -> imageData img
-                  x -> error $ "Pixel depth must be 8, "++show x++
-                               " is not supported"
+pixels :: Storable d => HIplImage a c d -> V.Vector d
+pixels img = V.unsafeFromForeignPtr (imageData img) 0 (imageSize img)
 
 doST :: IO a -> a
 doST x = runST (unsafeIOToST x)
@@ -83,107 +125,103 @@ doST x = runST (unsafeIOToST x)
 -- |Return a 'V.Vector' containing the pixels that make up an
 -- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
 -- pixel data.
-pixelsCopy :: HIplImage a -> V.Vector Word8
+pixelsCopy :: Storable d => HIplImage a c d -> V.Vector d
 pixelsCopy img = doST $ do ptr <- mallocForeignPtrBytes len
                            withForeignPtr ptr $
                               \dst -> withForeignPtr (imageData img) $
                                         \src -> copyBytes dst src len
-                           return $ V.unsafeFromForeignPtr ptr 0 (imageSize img)
+                           return $ V.unsafeFromForeignPtr ptr 0 len
     where len = imageSize img
 
--- |Return a 'V.Vector' containing the pixels that make up the
--- 16-bit-per-pixel 'HIplImage'.
-pixels16 :: HIplImage a -> V.Vector Word16
-pixels16 img = V.unsafeFromForeignPtr ptr 0 (imageSize img)
-    where ptr = case depth img of
-                  Depth 16 -> castForeignPtr (imageData img)
-                  x -> error $ "Pixel depth must be 16, "++show x++
-                               " is not supported"
-
 -- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: Ptr IplImage -> IO (HIplImage ())
+fromPtr :: (HasChannels c, HasDepth d, Storable d) => 
+           Ptr IplImage -> IO (HIplImage () c d)
 fromPtr = peek . castPtr
 
--- |Load an 'HIplImage' from an image file on disk. The first argument
--- is the name of the file to load. The second argument determines
--- the desired color format of the image.
-fromFile :: String -> LoadColor -> IO (HIplImage FreshImage)
-fromFile fileName col = unsafeCoerce . fromPtr =<< cvLoadImage fileName col
+-- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
+-- image will have three color channels.
+fromFileColor :: String -> IO (HIplImage FreshImage TriChromatic Word8)
+--fromFileColor fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadColor 
+fromFileColor fileName = do ptr <- cvLoadImage fileName LoadColor
+                            img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
+                            return $ unsafeCoerce img
 
-toFile :: String -> HIplImage a -> IO ()
+-- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
+-- image will have a single color channel.
+fromFileGray :: String -> IO (HIplImage FreshImage MonoChromatic Word8)
+--fromFileGray fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadGray
+fromFileGray fileName = do ptr <- cvLoadImage fileName LoadGray
+                           img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
+                           return $ unsafeCoerce img
+
+toFile :: (HasChannels c, HasDepth d, Storable d) => 
+          String -> HIplImage a c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 -- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
 -- and number of color channels with an allocated pixel buffer.
-mkHIplImage :: Int -> Int -> Int -> IO (HIplImage FreshImage)
-mkHIplImage w h numChan = 
-    -- do fp <- createImageF (CvSize w' h') numChan' iplDepth8u
-    --    withForeignPtr fp $ \p -> peek (castPtr p)
-    -- where w' = fromIntegral w
-    --       h' = fromIntegral h
-    --       numChan' = fromIntegral numChan
+mkHIplImage :: forall c d. (HasChannels c, HasDepth d, Storable d) => 
+               Int -> Int -> IO (HIplImage FreshImage c d)
+mkHIplImage w h = 
     do ptr <- mallocForeignPtrArray numBytes
-       return $ HIplImage numChan iplDepth8u 0 0 w h numBytes ptr stride
-    where numBytes = stride * h
-          stride = w * numChan
+       return $ HIplImage 0 w h numBytes ptr stride
+    where numBytes = stride * h * bpp
+          bpp = bytesPerPixel (depth (undefined::d))
+          stride = w * (numChannels (undefined::c) :: Int)
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
-compatibleImage :: HIplImage a -> IO (HIplImage FreshImage)
-compatibleImage img = 
+compatibleImage :: forall a c d. 
+                   HIplImage a c d -> IO (HIplImage FreshImage c d)
+compatibleImage img@(HIplImage _ _ _ _ _ _) = 
     do ptr <- mallocForeignPtrArray sz
-       return $ HIplImage nc d order 0 w h sz ptr stride
+       return $ HIplImage 0 w h sz ptr stride
     where w = width img
           h = height img
-          nc = numChannels img
-          d = depth img
-          order = dataOrder img
           sz = imageSize img
           stride = widthStep img
 
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
-duplicateImage :: HIplImage a -> IO (HIplImage FreshImage)
-duplicateImage img =
+duplicateImage :: forall a c d.
+                  HIplImage a c d -> IO (HIplImage FreshImage c d)
+duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
            \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
-       return $ HIplImage nc d 0 0 w h sz fptr stride
+       return $ HIplImage 0 w h sz fptr stride
     where w = width img
           h = height img
-          nc = numChannels img
-          d = depth img
           sz = imageSize img
           stride = widthStep img
 
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
--- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is shared
--- with the supplied 'V.Vector'.
-fromPixels :: Integral a => a -> a -> V.Vector Word8 -> HIplImage ()
-fromPixels w h pix = if fromIntegral len == sz 
-                     then HIplImage nc iplDepth8u 0 0 w' h' sz fp stride
+-- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is
+-- shared with the supplied 'V.Vector'.
+fromPixels :: forall a c. (HasChannels c, Integral a) =>
+              a -> a -> V.Vector Word8 -> HIplImage () c Word8
+fromPixels w h pix = if fromIntegral len == sz
+                     then HIplImage 0 w' h' sz fp (w'*nc)
                      else error "Length disagreement"
-    where nc = if V.length pix == w' * h' then 1 else 3
-          w' = fromIntegral w
+    where w' = fromIntegral w
           h' = fromIntegral h
+          nc = numChannels (undefined::c)
           sz = w' * h' * nc
-          stride = w' * nc
           (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
                          (fp,0,len) -> (fp,len)
                          _ -> error "fromPixels non-zero offset"
 
 -- |Construct a fresh 'HIplImage' from a width, a height, and a
 -- 'V.Vector' of 8-bit pixel values.
-fromPixelsCopy :: Integral a => a -> a -> V.Vector Word8 -> HIplImage FreshImage
-fromPixelsCopy w h pix = 
-    doST $ do fp <- copyData
-              return $ HIplImage nc iplDepth8u 0 0 w' h' sz fp stride
-    where nc = if V.length pix == w' * h' then 1 else 3
-          w' = fromIntegral w
+fromPixelsCopy :: forall a c. (Integral a, HasChannels c) =>
+                  a -> a -> V.Vector Word8 -> HIplImage FreshImage c Word8
+fromPixelsCopy w h pix = doST $ do fp <- copyData
+                                   return $ HIplImage 0 w' h' sz fp (w'*nc)
+    where w' = fromIntegral w
           h' = fromIntegral h
+          nc = numChannels (undefined::c)
           sz = w' * h' * nc
-          stride = w' * nc
           copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
                      in do fp <- mallocForeignPtrBytes len
                            withForeignPtr vfp $
@@ -192,25 +230,38 @@ fromPixelsCopy w h pix =
                                                in copyBytes dst src' len
                            return fp
 
+-- |Helper function to explicitly type a vector of monochromatic pixel
+-- data.
+fromGrayPixels :: Integral a => 
+                  a -> a -> V.Vector Word8 -> HIplImage () MonoChromatic Word8
+fromGrayPixels w h = isMono . fromPixels w h
+
+-- |Helper function to explicitly type a vector of trichromatic pixel
+-- data.
+fromColorPixels :: Integral a =>
+                   a -> a -> V.Vector Word8 -> HIplImage () TriChromatic Word8
+fromColorPixels w h = isColor . fromPixels w h
+
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
-withHIplImage :: HIplImage a -> (Ptr IplImage -> IO b) -> IO b
---withHIplImage img f = alloca $ \p -> poke p img >> f (castPtr p)
+withHIplImage :: (HasChannels c, HasDepth d, Storable d) =>
+                 HIplImage a c d -> (Ptr IplImage -> IO b) -> IO b
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
-                                           (\hp -> pokeIpl img p hp >>
+                                           (\hp -> pokeIpl img p (castPtr hp) >>
                                                    f (castPtr p))
 
 -- Poke a 'Ptr' 'HIplImage' with a specific imageData 'Ptr' that is
 -- currently valid. This is solely an auxiliary function to
 -- 'withHIplImage'.
-pokeIpl :: HIplImage a -> Ptr (HIplImage a) -> Ptr Word8 -> IO ()
+pokeIpl :: forall a c d. (HasChannels c, HasDepth d) => 
+           HIplImage a c d -> Ptr (HIplImage a c d) -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
     do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
        (#poke IplImage, ID) ptr (0::Int)
-       (#poke IplImage, nChannels) ptr (numChannels himg)
-       (#poke IplImage, depth) ptr (unDepth (depth himg))
-       (#poke IplImage, dataOrder) ptr (dataOrder himg)
+       (#poke IplImage, nChannels) ptr (numChannels (undefined::c))
+       (#poke IplImage, depth) ptr (unDepth (depth (undefined::d)))
+       (#poke IplImage, dataOrder) ptr (0::Int)
        (#poke IplImage, origin) ptr (origin himg)
        (#poke IplImage, align) ptr (4::Int)
        (#poke IplImage, width) ptr (width himg)
@@ -227,29 +278,25 @@ pokeIpl himg ptr hp =
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'. Returns the duplicate 'HIplImage' after
--- performing the given action
-withDuplicateImage :: HIplImage a -> (Ptr IplImage -> IO b) -> HIplImage FreshImage
+-- performing the given action along with the result of that action.
+withDuplicateImage :: (HasChannels c, HasDepth d, Storable d) => 
+                      HIplImage a c d -> (Ptr IplImage -> IO b) -> 
+                      (HIplImage FreshImage c d, b)
 withDuplicateImage img1 f = runST $ unsafeIOToST $
                             do img2 <- duplicateImage img1
-                               _ <- withHIplImage img2 f
-                               return img2
-
--- |Provides the supplied function with a 'Ptr' to an 'IplImage' that
--- is a duplicate of the given 'HIplImage'. Returns the result of the
--- given 'IO' action.
-withDuplicateImage' :: HIplImage a -> (Ptr IplImage -> IO b) -> b
-withDuplicateImage' img1 f = runST $ unsafeIOToST $
-                             do img2 <- duplicateImage img1
-                                withHIplImage img2 f
+                               r <- withHIplImage img2 f
+                               return (img2, r)
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
-withCompatibleImage :: HIplImage a -> (Ptr IplImage -> IO b) -> HIplImage FreshImage
+withCompatibleImage :: (HasChannels c, HasDepth d, Storable d) => 
+                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
+                       (HIplImage FreshImage c d, b)
 withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
-                                _ <- withHIplImage img2 f
-                                return img2
+                                r <- withHIplImage img2 f
+                                return (img2, r)
 
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
@@ -261,7 +308,8 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
 -- values constructed within the Haskell runtime, on the other hand,
 -- do have their underlying pixel data buffers registered with a
 -- finalizer.
-instance Storable (HIplImage a) where
+instance forall a c d. (HasChannels c, HasDepth d, Storable d) => 
+    Storable (HIplImage a c d) where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
@@ -284,17 +332,28 @@ instance Storable (HIplImage a) where
     --   withForeignPtr (imageDataOrigin himg) $ 
     --     \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
-      numChannels' <- (#peek IplImage, nChannels) ptr
+      numChannels' <- (#peek IplImage, nChannels) ptr :: IO Int
       depth' <- Depth <$> (#peek IplImage, depth) ptr
-      dataOrder' <- (#peek IplImage, dataOrder) ptr
-      origin' <- (#peek IplImage, origin) ptr
       width' <- (#peek IplImage, width) ptr
       height' <- (#peek IplImage, height) ptr
-      imageSize' <- (#peek IplImage, imageSize) ptr
-      imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
-      widthStep' <- (#peek IplImage, widthStep) ptr
-      return $ HIplImage numChannels' depth' dataOrder' origin' 
-                         width' height' imageSize' imageData' widthStep' 
+      when (depth' /= (depth (undefined::d)))
+           (error $ "IplImage has depth "++show depth'++
+                    " but desired HIplImage has depth "++
+                    show (depth (undefined::d)))
+      if numChannels (undefined::c) /= numChannels'
+        then do img2 <- mkHIplImage width' height' :: IO (HIplImage FreshImage c d)
+                let conv = if numChannels' == 1 
+                           then cv_GRAY2BGR
+                           else cv_BGR2GRAY
+                    ptr' = castPtr ptr :: Ptr IplImage
+                withHIplImage img2 $ \dst -> cvCvtColor ptr' dst conv
+                return $ unsafeCoerce img2
+        else do origin' <- (#peek IplImage, origin) ptr
+                imageSize' <- (#peek IplImage, imageSize) ptr
+                imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
+                widthStep' <- (#peek IplImage, widthStep) ptr
+                return $ HIplImage origin' width' height' imageSize' 
+                                   imageData' widthStep'
 
 
 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index a8c6cc6..bc25a71 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -3,41 +3,48 @@
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, convertColor, 
-                            HIplImage, width, height, numChannels, pixels, 
-                            fromPixels, fromFile, toFile, findContours) 
+                            LineType(..), RGB, drawLines, HIplImage, width, 
+                            height, pixels, fromGrayPixels, fromColorPixels, 
+                            fromFileGray, fromFileColor, toFile, findContours, 
+                            convertGrayToRGB, convertGrayToBGR, fromPtr, 
+                            convertRGBToGray, convertBGRToGray, isColor, isMono, 
+                            fromPixels, fromPixelsCopy)
     where
 import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HIplImage
 import Control.Monad.ST (runST, unsafeIOToST)
+import Data.Word (Word8)
 import Foreign.Ptr
 import Foreign.Storable
 import Unsafe.Coerce
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: Int -> HIplImage a -> HIplImage FreshImage
+erode :: (HasChannels c, HasDepth d, Storable d) =>
+         Int -> HIplImage a c d -> HIplImage FreshImage c d
 erode n img = runST $
               unsafeIOToST . withHIplImage img $
-              \src -> return . withCompatibleImage img $
+              \src -> return . fst . withCompatibleImage img $
                       \dst -> cvErode src dst n'
     where n' = fromIntegral n
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: Int -> HIplImage a -> HIplImage FreshImage
+dilate :: (HasChannels c, HasDepth d, Storable d) =>
+          Int -> HIplImage a c d -> HIplImage FreshImage c d
 dilate n img = runST $ 
                unsafeIOToST . withHIplImage img $
-               \src -> return . withCompatibleImage img $
+               \src -> return . fst . withCompatibleImage img $
                        \dst -> cvDilate src dst n'
     where n' = fromIntegral n
 
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the fusion rewrite rules when there is
 -- no way to observe the input image.
-unsafeErode :: Int -> HIplImage a -> HIplImage FreshImage
+unsafeErode :: (HasChannels c, HasDepth d, Storable d) =>
+               Int -> HIplImage a c d -> HIplImage FreshImage c d
 unsafeErode n img = runST $ 
                     unsafeIOToST $
                         withHIplImage img (\src -> cvErode src src n') >> 
@@ -47,7 +54,8 @@ unsafeErode n img = runST $
 -- |Unsafe in-place dilation. This is a destructive update of the
 -- given image and is only used by the fusion rewrite rules when
 -- there is no way to observe the input image.
-unsafeDilate :: Int -> HIplImage a -> HIplImage FreshImage
+unsafeDilate :: (HasChannels c, HasDepth d, Storable d) =>
+                Int -> HIplImage a c d-> HIplImage FreshImage c d
 unsafeDilate n img = runST $ 
                      unsafeIOToST $
                          withHIplImage img (\src -> cvDilate src src n') >> 
@@ -61,12 +69,13 @@ unsafeDilate n img = runST $
 -- operations are known to be safe.
 
 {-# RULES 
-"erode-in-place"  forall n (f::a->HIplImage FreshImage). erode n . f = unsafeErode n . f
-"dilate-in-place" forall n (f::a->HIplImage FreshImage). dilate n . f = unsafeDilate n . f
+"erode-in-place"  forall n (f::a -> HIplImage FreshImage c d). erode n . f = unsafeErode n . f
+"dilate-in-place" forall n (f::a -> HIplImage FreshImage c d). dilate n . f = unsafeDilate n . f
   #-}
 
 -- |Line detection in a binary image using a standard Hough transform.
-houghStandard :: Double -> Double -> Int -> HIplImage a -> [((Int, Int),(Int,Int))]
+houghStandard :: Double -> Double -> Int -> HIplImage a MonoChromatic Word8 -> 
+                 [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = runST $ unsafeIOToST $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        cvSeq <- withHIplImage img $ 
@@ -92,13 +101,13 @@ houghStandard rho theta threshold img = runST $ unsafeIOToST $
 
 -- |Line detection in a binary image using a probabilistic Hough transform.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage a -> [((Int, Int),(Int,Int))]
+                      HIplImage a MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     runST $ unsafeIOToST $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
-       cvSeq <- withHIplImage img $
-                \p -> cvHoughLines2 p storage 1 rho theta threshold minLength 
-                                    maxGap
+       let cvSeq = snd $ withDuplicateImage img $
+                     \p -> cvHoughLines2 p storage 1 rho theta threshold
+                                         minLength maxGap
        hlines <- mapM (\p1 -> do x1 <- peek p1
                                  let p2 = plusPtr p1 step
                                      p3 = plusPtr p2 step
@@ -129,16 +138,18 @@ lineTypeEnum AALine    = 16
 -- |Draw each line, defined by its endpoints, on a duplicate of the
 -- given 'HIplImage' using the specified RGB color, line thickness,
 -- and aliasing style. This function is fusible under composition.
-drawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-             HIplImage a -> HIplImage FreshImage
+drawLines :: (HasChannels c, HasDepth d, Storable d) =>
+             RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
+             HIplImage a c d -> HIplImage FreshImage c d
 drawLines col thick lineType lines img = 
-    withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
+    fst $ withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 
 -- |Unsafe in-place line drawing.
-unsafeDrawLines :: RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-                   HIplImage a -> HIplImage FreshImage
+unsafeDrawLines :: (HasChannels c, HasDepth d, Storable d) =>
+                   RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
+                   HIplImage a c d -> HIplImage FreshImage c d
 unsafeDrawLines col thick lineType lines img = 
     runST $ unsafeIOToST $
     withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return (unsafeCoerce img)
@@ -146,27 +157,44 @@ unsafeDrawLines col thick lineType lines img =
           lineType' = lineTypeEnum lineType
 
 {-# RULES
-  "draw-lines-in-place" forall c t lt lns (f::a->HIplImage FreshImage). 
+  "draw-lines-in-place" forall c t lt lns (f::a -> HIplImage FreshImage c d). 
   drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
   #-}
 
 -- |Convert the color model of an image.
-convertColor :: ColorConversion -> HIplImage a -> HIplImage FreshImage
+convertGrayToRGB :: (HasDepth d, Storable d) =>
+                    HIplImage a MonoChromatic d -> HIplImage FreshImage TriChromatic d
+convertGrayToRGB = convertColor cv_GRAY2RGB
+
+convertGrayToBGR :: (HasDepth d, Storable d) =>
+                    HIplImage a MonoChromatic d -> HIplImage FreshImage TriChromatic d
+convertGrayToBGR = convertColor cv_GRAY2BGR
+
+convertBGRToGray :: (HasDepth d, Storable d) =>
+                    HIplImage a TriChromatic d -> HIplImage FreshImage MonoChromatic d
+convertBGRToGray = convertColor cv_BGR2GRAY
+
+convertRGBToGray :: (HasDepth d, Storable d) =>
+                    HIplImage a TriChromatic d -> HIplImage FreshImage MonoChromatic d
+convertRGBToGray = convertBGRToGray
+
+convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, Storable d) =>
+                ColorConversion -> HIplImage a c1 d -> HIplImage FreshImage c2 d
 convertColor cc img = runST $ unsafeIOToST $ 
-                       withHIplImage img $
-                       \src -> do dst <- mkHIplImage w h nc
-                                  withHIplImage dst $
-                                    \dst' -> cvCvtColor src dst' cc
-                                  return dst
+                      withHIplImage img $
+                        \src -> do dst <- mkHIplImage w h
+                                   withHIplImage dst $
+                                     \dst' -> cvCvtColor src dst' cc
+                                   return dst
     where w = width img
           h = height img
-          destChannels = [(cv_RGB2BGR, 3), (cv_BGR2GRAY, 1), (cv_GRAY2BGR, 3)]
-          nc = case lookup cc destChannels of
-                 Just n -> n
-                 Nothing -> error $ "Unfamiliar color conversion. "++
-                                    "Contact maintainer."
+          -- destChannels = [(cv_RGB2BGR, 3), (cv_BGR2GRAY, 1), (cv_GRAY2BGR, 3)]
+          -- nc = case lookup cc destChannels of
+          --        Just n -> n
+          --        Nothing -> error $ "Unfamiliar color conversion. "++
+          --                           "Contact maintainer."
 
 -- |Find the 'CvContour's in an image.
-findContours :: HIplImage a -> [CvContour]
-findContours img = withDuplicateImage' img $
+findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
+findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 12caa90..9aef751 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -6,7 +6,7 @@
 module AI.CV.OpenCV.PixelUtils where
 import AI.CV.OpenCV.HIplImage
 import Control.Monad.ST (runST)
-import Data.Word (Word8)
+import Data.Vector.Storable (Storable)
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as VM
 import qualified Data.Vector.Generic as VG
@@ -22,7 +22,7 @@ rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
 
 -- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded rows
 -- to tightly packed rows of RGB pixels.
-toRGB :: HIplImage a -> V.Vector Word8
+toRGB :: Storable d => HIplImage a TriChromatic d -> V.Vector d
 toRGB img = V.backpermute (pixels img) $
             rgbIndices (width img) (widthStep img) (imageSize img)
 
@@ -30,7 +30,7 @@ toRGB img = V.backpermute (pixels img) $
 -- rows to tightly packed rows of RGB pixels using the given
 -- 'V.Vector' of indices. The index 'Vector' will typically be the
 -- result of a previous call to 'rgbIndices'.
-toRGB' :: HIplImage a -> V.Vector Int -> V.Vector Word8
+toRGB' :: Storable d => HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
 toRGB' img inds = V.backpermute (pixels img) inds
 
 -- |Drop any pixels beyond real image data on each row.
@@ -41,11 +41,10 @@ dropAlpha w = V.ifilter (\i _ -> (i `rem` rowLength) < realWidth)
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: Int -> HIplImage a -> V.Vector Word8
+isolateChannel :: Storable d => Int -> HIplImage a TriChromatic d -> V.Vector d
 isolateChannel ch img = 
-    if ch >= 3 || numCh /= 3
-    then error $ "Invalid channel "++show ch++" for image with "++show numCh++
-                 " color channels"
+    if ch < 0 || ch >= 3
+    then error $ "Invalid channel "++show ch++" for trichromatic image"
     else runST $ do v <- VM.new (w*h)
                     let go !x !p !p3 !y
                             | y >= h = VG.unsafeFreeze v
@@ -53,16 +52,16 @@ isolateChannel ch img =
                             | otherwise = do VM.unsafeWrite v p (get p3)
                                              go (x+1) (p+1) (p3+3) y
                     go 0 0 ch 0
-    where numCh = numChannels img
-          w = width img
+    where w = width img
           h = height img
           margin = widthStep img - (w  * 3)
           pix = pixels img
           get = V.unsafeIndex pix
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: HIplImage a -> V.Vector Word8
-toMono img = if numChannels img == 1 then dropAlpha w pix 
+toMono :: (HasChannels c, Storable d, Integral d) => 
+          HIplImage a c d -> V.Vector d
+toMono img = if imgChannels img == 1 then dropAlpha w pix 
              else runST $ do v <- VM.new (w*h)
                              let go !x !p !p3 !y
                                      | y >= h = VG.unsafeFreeze v
@@ -75,9 +74,8 @@ toMono img = if numChannels img == 1 then dropAlpha w pix
           h = height img
           margin = widthStep img - (w * 3)
           pix = pixels img
-          get :: Int -> Int
           get = fromIntegral . V.unsafeIndex pix
           getAvg i = avg (get i) (get (i+1)) (get (i+2))
-          avg :: Int -> Int -> Int -> Word8
           avg b g r = fromIntegral $ (b + g + r) `div` 3
+          
 

From 5e638066c6a9931a7c774fd2188e87afcbc0bc6c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 17:59:17 -0400
Subject: [PATCH 020/137] Marked Vector-using functions INLINE.

The parametricity over pixel depth can lead to generic paths
through Data.Vector code. That is horribly slow, so such
functions must be compiled with the concrete type they are
used at. Marking them as INLINE addresses this, but it is something
that needs minding.
---
 src/AI/CV/OpenCV/HIplImage.hsc |  3 +++
 src/AI/CV/OpenCV/PixelUtils.hs | 11 ++++++++---
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 495f249..4b69154 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -110,6 +110,9 @@ isColor = id
 isMono :: HIplImage a MonoChromatic d -> HIplImage a MonoChromatic d
 isMono = id
 
+{-# INLINE isMono #-}
+{-# INLINE isColor #-}
+
 imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 9aef751..b7bfa01 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
 -- |Images obtained from OpenCV usually have the components of color
 -- pixels arranged in BGR order and pad image rows with unused
 -- bytes. This module provides mechanisms to re-order pixels to RGB
@@ -25,6 +25,7 @@ rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
 toRGB :: Storable d => HIplImage a TriChromatic d -> V.Vector d
 toRGB img = V.backpermute (pixels img) $
             rgbIndices (width img) (widthStep img) (imageSize img)
+{-# INLINE toRGB #-}
 
 -- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded
 -- rows to tightly packed rows of RGB pixels using the given
@@ -32,12 +33,14 @@ toRGB img = V.backpermute (pixels img) $
 -- result of a previous call to 'rgbIndices'.
 toRGB' :: Storable d => HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
 toRGB' img inds = V.backpermute (pixels img) inds
+{-# INLINE toRGB' #-}
 
 -- |Drop any pixels beyond real image data on each row.
 dropAlpha :: V.Storable a => Int -> V.Vector a -> V.Vector a
 dropAlpha w = V.ifilter (\i _ -> (i `rem` rowLength) < realWidth)
     where rowLength = w * 4
           realWidth = w * 3
+{-# INLINE dropAlpha #-}
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
@@ -57,9 +60,10 @@ isolateChannel ch img =
           margin = widthStep img - (w  * 3)
           pix = pixels img
           get = V.unsafeIndex pix
+{-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, Storable d, Integral d) => 
+toMono :: forall a c d. (HasChannels c, HasDepth d, Storable d, Integral d) => 
           HIplImage a c d -> V.Vector d
 toMono img = if imgChannels img == 1 then dropAlpha w pix 
              else runST $ do v <- VM.new (w*h)
@@ -76,6 +80,7 @@ toMono img = if imgChannels img == 1 then dropAlpha w pix
           pix = pixels img
           get = fromIntegral . V.unsafeIndex pix
           getAvg i = avg (get i) (get (i+1)) (get (i+2))
+          avg :: Int -> Int -> Int -> d
           avg b g r = fromIntegral $ (b + g + r) `div` 3
-          
+{-# INLINE toMono #-}          
 

From 4034715af1d2aa93f631391b8b0081edaebb10a6 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 18:04:12 -0400
Subject: [PATCH 021/137] Updated README file.

---
 README | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/README b/README
index bba9a97..210d0c3 100644
--- a/README
+++ b/README
@@ -1,15 +1,16 @@
 HOpenCV
 -------
 
-OpenCV bindings for Haskell (rather low-level)
+OpenCV 2.1 bindings for Haskell.
 
-For a functional wrapping of this library, see cv-combinators
+- Image color channel count and color depth are statically checked.
 
+- A functional interface is provided through the HighCV module.
 
-TODO:
------
+- When operations are directly composed, they will be performed
+  in-place where possible as the intermediate images are not
+  observable.
 
-* Embed the depth and number of channels of images in their type using a typeclass
-  This will make things a little safer (e.g. prevent us calling cvCanny with color images in most cases)
+NOTE: Only a small part of OpenCV is currently wrapped.
 
 

From 2c11e4f11bfc94d0da905acbac60976353f65cb9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 18:30:43 -0400
Subject: [PATCH 022/137] Refactoring into two new modules.

Split parts of HIplImage into HIplUtils.
Split parts of HighCV into HighColorConv.

The main entrypoint is still HighCV, but the implementation
is a bit more broken up now as some of the modules have gotten
quite unwieldy.
---
 HOpenCV.cabal                     |   2 +
 src/AI/CV/OpenCV/HIplImage.hsc    | 182 +----------------------------
 src/AI/CV/OpenCV/HIplUtils.hs     | 183 ++++++++++++++++++++++++++++++
 src/AI/CV/OpenCV/HighCV.hs        |  44 +------
 src/AI/CV/OpenCV/HighColorConv.hs |  41 +++++++
 src/AI/CV/OpenCV/PixelUtils.hs    |   1 +
 6 files changed, 237 insertions(+), 216 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/HIplUtils.hs
 create mode 100644 src/AI/CV/OpenCV/HighColorConv.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 84c3b38..6e6e43b 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -28,6 +28,7 @@ library
       AI.CV.OpenCV.HighGui
       AI.CV.OpenCV.Types
       AI.CV.OpenCV.HIplImage
+      AI.CV.OpenCV.HIplUtils
       AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
@@ -35,6 +36,7 @@ library
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
    extra-libraries: cxcore,cv,highgui
+   other-modules: AI.CV.OpenCV.HighColorConv
    build-depends: base >=4 && <5, 
                   allocated-processor >= 0.0.1, 
                   vector-space,
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 4b69154..89c2f84 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,24 +1,14 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
-module AI.CV.OpenCV.HIplImage 
-    ( HIplImage, FreshImage, TriChromatic, MonoChromatic, HasChannels,
-      HasDepth, width, height, imageSize, widthStep, pixels, pixelsCopy, 
-      fromPtr, fromFileColor, fromFileGray, toFile, fromGrayPixels, isColor,
-      fromColorPixels, withHIplImage, fromPixels, fromPixelsCopy,
-      imgChannels, withCompatibleImage, withDuplicateImage, mkHIplImage, isMono)
-    where
+module AI.CV.OpenCV.HIplImage where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u)
 import AI.CV.OpenCV.CV (cvCvtColor)
-import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
-import Control.Monad.ST (runST, unsafeIOToST)
-import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr
 import Foreign.Storable
 import Unsafe.Coerce
@@ -77,19 +67,14 @@ bytesPerPixel :: Depth -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unDepth
 
 -- |A Haskell data structure representing the information OpenCV uses
--- from an 'IplImage' struct.
-{-
-data HIplImage a c d = HIplImage { origin          :: Int
-                                 , width           :: Int
-                                 , height          :: Int
-                                 , imageSize       :: Int
-                                 , imageData       :: ForeignPtr d
-                                 , widthStep       :: Int }
--}
+-- from an 'IplImage' struct. It includes the pixel origin, image
+-- width, image height, image size (number of bytes), a pointer to the
+-- pixel data, and the row stride.
 data HIplImage a c d where
     HIplImage :: (HasChannels c, HasDepth d, Storable d) => 
                  Int -> Int -> Int -> Int -> ForeignPtr d -> Int -> 
                  HIplImage a c d
+
 origin, width, height, imageSize, widthStep :: HIplImage a c d -> Int
 origin (HIplImage o _ _ _ _ _) = o
 width (HIplImage _ w _ _ _ _) = w
@@ -100,67 +85,6 @@ widthStep (HIplImage _ _ _ _ _ s) = s
 imageData :: HIplImage a c d -> ForeignPtr d
 imageData (HIplImage _ _ _ _ d _) = d
 
--- |This is a way to let the type checker know that you belieave an
--- image to be tri-chromatic.
-isColor :: HIplImage a TriChromatic d -> HIplImage a TriChromatic d
-isColor = id
-
--- |This is a way to let the type checker know that you believe an
--- image to be monochromatic.
-isMono :: HIplImage a MonoChromatic d -> HIplImage a MonoChromatic d
-isMono = id
-
-{-# INLINE isMono #-}
-{-# INLINE isColor #-}
-
-imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
-imgChannels _ = numChannels (undefined::c)
-
--- |Return a 'V.Vector' containing the pixels that make up an
--- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
--- data!
-pixels :: Storable d => HIplImage a c d -> V.Vector d
-pixels img = V.unsafeFromForeignPtr (imageData img) 0 (imageSize img)
-
-doST :: IO a -> a
-doST x = runST (unsafeIOToST x)
-
--- |Return a 'V.Vector' containing the pixels that make up an
--- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
--- pixel data.
-pixelsCopy :: Storable d => HIplImage a c d -> V.Vector d
-pixelsCopy img = doST $ do ptr <- mallocForeignPtrBytes len
-                           withForeignPtr ptr $
-                              \dst -> withForeignPtr (imageData img) $
-                                        \src -> copyBytes dst src len
-                           return $ V.unsafeFromForeignPtr ptr 0 len
-    where len = imageSize img
-
--- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: (HasChannels c, HasDepth d, Storable d) => 
-           Ptr IplImage -> IO (HIplImage () c d)
-fromPtr = peek . castPtr
-
--- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
--- image will have three color channels.
-fromFileColor :: String -> IO (HIplImage FreshImage TriChromatic Word8)
---fromFileColor fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadColor 
-fromFileColor fileName = do ptr <- cvLoadImage fileName LoadColor
-                            img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
-                            return $ unsafeCoerce img
-
--- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
--- image will have a single color channel.
-fromFileGray :: String -> IO (HIplImage FreshImage MonoChromatic Word8)
---fromFileGray fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadGray
-fromFileGray fileName = do ptr <- cvLoadImage fileName LoadGray
-                           img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
-                           return $ unsafeCoerce img
-
-toFile :: (HasChannels c, HasDepth d, Storable d) => 
-          String -> HIplImage a c d -> IO ()
-toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
-
 -- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
 -- and number of color channels with an allocated pixel buffer.
 mkHIplImage :: forall c d. (HasChannels c, HasDepth d, Storable d) => 
@@ -172,79 +96,6 @@ mkHIplImage w h =
           bpp = bytesPerPixel (depth (undefined::d))
           stride = w * (numChannels (undefined::c) :: Int)
 
--- |Allocate a new 'HIplImage' with the same dimensions, number of
--- color channels, and color depth as an existing HIplImage. The pixel
--- data of the original 'HIplImage' is not copied.
-compatibleImage :: forall a c d. 
-                   HIplImage a c d -> IO (HIplImage FreshImage c d)
-compatibleImage img@(HIplImage _ _ _ _ _ _) = 
-    do ptr <- mallocForeignPtrArray sz
-       return $ HIplImage 0 w h sz ptr stride
-    where w = width img
-          h = height img
-          sz = imageSize img
-          stride = widthStep img
-
--- |Create an exact duplicate of the given HIplImage. This allocates a
--- fresh array to store the copied pixels.
-duplicateImage :: forall a c d.
-                  HIplImage a c d -> IO (HIplImage FreshImage c d)
-duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
-    do fptr <- mallocForeignPtrArray sz
-       withForeignPtr (imageData img) $ 
-           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
-       return $ HIplImage 0 w h sz fptr stride
-    where w = width img
-          h = height img
-          sz = imageSize img
-          stride = widthStep img
-
--- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
--- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is
--- shared with the supplied 'V.Vector'.
-fromPixels :: forall a c. (HasChannels c, Integral a) =>
-              a -> a -> V.Vector Word8 -> HIplImage () c Word8
-fromPixels w h pix = if fromIntegral len == sz
-                     then HIplImage 0 w' h' sz fp (w'*nc)
-                     else error "Length disagreement"
-    where w' = fromIntegral w
-          h' = fromIntegral h
-          nc = numChannels (undefined::c)
-          sz = w' * h' * nc
-          (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
-                         (fp,0,len) -> (fp,len)
-                         _ -> error "fromPixels non-zero offset"
-
--- |Construct a fresh 'HIplImage' from a width, a height, and a
--- 'V.Vector' of 8-bit pixel values.
-fromPixelsCopy :: forall a c. (Integral a, HasChannels c) =>
-                  a -> a -> V.Vector Word8 -> HIplImage FreshImage c Word8
-fromPixelsCopy w h pix = doST $ do fp <- copyData
-                                   return $ HIplImage 0 w' h' sz fp (w'*nc)
-    where w' = fromIntegral w
-          h' = fromIntegral h
-          nc = numChannels (undefined::c)
-          sz = w' * h' * nc
-          copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
-                     in do fp <- mallocForeignPtrBytes len
-                           withForeignPtr vfp $
-                             \src -> withForeignPtr fp $
-                                       \dst -> let src' = plusPtr src offset
-                                               in copyBytes dst src' len
-                           return fp
-
--- |Helper function to explicitly type a vector of monochromatic pixel
--- data.
-fromGrayPixels :: Integral a => 
-                  a -> a -> V.Vector Word8 -> HIplImage () MonoChromatic Word8
-fromGrayPixels w h = isMono . fromPixels w h
-
--- |Helper function to explicitly type a vector of trichromatic pixel
--- data.
-fromColorPixels :: Integral a =>
-                   a -> a -> V.Vector Word8 -> HIplImage () TriChromatic Word8
-fromColorPixels w h = isColor . fromPixels w h
-
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: (HasChannels c, HasDepth d, Storable d) =>
@@ -278,29 +129,6 @@ pokeIpl himg ptr hp =
        (#poke IplImage, widthStep) ptr (widthStep himg)
        (#poke IplImage, imageDataOrigin) ptr hp
 
--- |Provides the supplied function with a 'Ptr' to the 'IplImage'
--- underlying a new 'HIplImage' that is an exact duplicate of the
--- given 'HIplImage'. Returns the duplicate 'HIplImage' after
--- performing the given action along with the result of that action.
-withDuplicateImage :: (HasChannels c, HasDepth d, Storable d) => 
-                      HIplImage a c d -> (Ptr IplImage -> IO b) -> 
-                      (HIplImage FreshImage c d, b)
-withDuplicateImage img1 f = runST $ unsafeIOToST $
-                            do img2 <- duplicateImage img1
-                               r <- withHIplImage img2 f
-                               return (img2, r)
-
--- |Provides the supplied function with a 'Ptr' to the 'IplImage'
--- underlying a new 'HIplImage' of the same dimensions as the given
--- 'HIplImage'.
-withCompatibleImage :: (HasChannels c, HasDepth d, Storable d) => 
-                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
-                       (HIplImage FreshImage c d, b)
-withCompatibleImage img1 f = runST $ unsafeIOToST $
-                             do img2 <- compatibleImage img1
-                                r <- withHIplImage img2 f
-                                return (img2, r)
-
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
 -- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
new file mode 100644
index 0000000..1160579
--- /dev/null
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- |Functions for working with 'HIplImage's.
+module AI.CV.OpenCV.HIplUtils (isColor, isMono, imgChannels, pixels, pixelsCopy,
+                               fromPtr, fromFileColor, fromFileGray, toFile, 
+                               compatibleImage, duplicateImage, fromPixels, 
+                               fromPixelsCopy, fromGrayPixels, fromColorPixels, 
+                               withDuplicateImage, withCompatibleImage, 
+                               HIplImage, mkHIplImage, width, height, 
+                               withHIplImage, FreshImage, MonoChromatic, 
+                               TriChromatic, HasChannels, HasDepth) where
+import AI.CV.OpenCV.CxCore (IplImage)
+import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
+import AI.CV.OpenCV.HIplImage
+import Control.Monad.ST (runST, unsafeIOToST)
+import qualified Data.Vector.Storable as V
+import Data.Word (Word8)
+import Foreign.ForeignPtr
+import Foreign.Marshal.Utils (copyBytes)
+import Foreign.Ptr
+import Foreign.Storable
+import Unsafe.Coerce
+
+-- |This is a way to let the type checker know that you belieave an
+-- image to be tri-chromatic.
+isColor :: HIplImage a TriChromatic d -> HIplImage a TriChromatic d
+isColor = id
+
+-- |This is a way to let the type checker know that you believe an
+-- image to be monochromatic.
+isMono :: HIplImage a MonoChromatic d -> HIplImage a MonoChromatic d
+isMono = id
+
+{-# INLINE isMono #-}
+{-# INLINE isColor #-}
+
+imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
+imgChannels _ = numChannels (undefined::c)
+
+-- |Return a 'V.Vector' containing the pixels that make up an
+-- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
+-- data!
+pixels :: Storable d => HIplImage a c d -> V.Vector d
+pixels img = V.unsafeFromForeignPtr (imageData img) 0 (imageSize img)
+
+doST :: IO a -> a
+doST x = runST (unsafeIOToST x)
+
+-- |Return a 'V.Vector' containing the pixels that make up an
+-- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
+-- pixel data.
+pixelsCopy :: Storable d => HIplImage a c d -> V.Vector d
+pixelsCopy img = doST $ do ptr <- mallocForeignPtrBytes len
+                           withForeignPtr ptr $
+                              \dst -> withForeignPtr (imageData img) $
+                                        \src -> copyBytes dst src len
+                           return $ V.unsafeFromForeignPtr ptr 0 len
+    where len = imageSize img
+
+-- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
+fromPtr :: (HasChannels c, HasDepth d, Storable d) => 
+           Ptr IplImage -> IO (HIplImage () c d)
+fromPtr = peek . castPtr
+
+-- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
+-- image will have three color channels.
+fromFileColor :: String -> IO (HIplImage FreshImage TriChromatic Word8)
+--fromFileColor fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadColor 
+fromFileColor fileName = do ptr <- cvLoadImage fileName LoadColor
+                            img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
+                            return $ unsafeCoerce img
+
+-- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
+-- image will have a single color channel.
+fromFileGray :: String -> IO (HIplImage FreshImage MonoChromatic Word8)
+--fromFileGray fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadGray
+fromFileGray fileName = do ptr <- cvLoadImage fileName LoadGray
+                           img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
+                           return $ unsafeCoerce img
+
+toFile :: (HasChannels c, HasDepth d, Storable d) => 
+          String -> HIplImage a c d -> IO ()
+toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
+
+
+-- |Allocate a new 'HIplImage' with the same dimensions, number of
+-- color channels, and color depth as an existing HIplImage. The pixel
+-- data of the original 'HIplImage' is not copied.
+compatibleImage :: forall a c d. 
+                   HIplImage a c d -> IO (HIplImage FreshImage c d)
+compatibleImage img@(HIplImage _ _ _ _ _ _) = 
+    do ptr <- mallocForeignPtrArray sz
+       return $ HIplImage 0 w h sz ptr stride
+    where w = width img
+          h = height img
+          sz = imageSize img
+          stride = widthStep img
+
+-- |Create an exact duplicate of the given HIplImage. This allocates a
+-- fresh array to store the copied pixels.
+duplicateImage :: forall a c d.
+                  HIplImage a c d -> IO (HIplImage FreshImage c d)
+duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
+    do fptr <- mallocForeignPtrArray sz
+       withForeignPtr (imageData img) $ 
+           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
+       return $ HIplImage 0 w h sz fptr stride
+    where w = width img
+          h = height img
+          sz = imageSize img
+          stride = widthStep img
+
+-- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
+-- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is
+-- shared with the supplied 'V.Vector'.
+fromPixels :: forall a c d. 
+              (HasChannels c, Integral a, HasDepth d, Storable d) =>
+              a -> a -> V.Vector d -> HIplImage () c d
+fromPixels w h pix = if fromIntegral len == sz
+                     then HIplImage 0 w' h' sz fp (w'*nc)
+                     else error "Length disagreement"
+    where w' = fromIntegral w
+          h' = fromIntegral h
+          nc = numChannels (undefined::c)
+          sz = w' * h' * nc
+          (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
+                         (fp,0,len) -> (fp,len)
+                         _ -> error "fromPixels non-zero offset"
+{-# INLINE fromPixels #-}
+
+-- |Construct a fresh 'HIplImage' from a width, a height, and a
+-- 'V.Vector' of 8-bit pixel values.
+fromPixelsCopy :: forall a c d. 
+                  (Integral a, HasChannels c, HasDepth d, Storable d) =>
+                  a -> a -> V.Vector d -> HIplImage FreshImage c d
+fromPixelsCopy w h pix = doST $ do fp <- copyData
+                                   return $ HIplImage 0 w' h' sz fp (w'*nc)
+    where w' = fromIntegral w
+          h' = fromIntegral h
+          nc = numChannels (undefined::c)
+          sz = w' * h' * nc
+          copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
+                     in do fp <- mallocForeignPtrBytes len
+                           withForeignPtr vfp $
+                             \src -> withForeignPtr fp $
+                                       \dst -> let src' = plusPtr src offset
+                                               in copyBytes dst src' len
+                           return fp
+{-# INLINE fromPixelsCopy #-}
+
+-- |Helper function to explicitly type a vector of monochromatic pixel
+-- data.
+fromGrayPixels :: Integral a => 
+                  a -> a -> V.Vector Word8 -> HIplImage () MonoChromatic Word8
+fromGrayPixels w h = isMono . fromPixels w h
+
+-- |Helper function to explicitly type a vector of trichromatic pixel
+-- data.
+fromColorPixels :: Integral a =>
+                   a -> a -> V.Vector Word8 -> HIplImage () TriChromatic Word8
+fromColorPixels w h = isColor . fromPixels w h
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'HIplImage' that is an exact duplicate of the
+-- given 'HIplImage'. Returns the duplicate 'HIplImage' after
+-- performing the given action along with the result of that action.
+withDuplicateImage :: (HasChannels c, HasDepth d, Storable d) => 
+                      HIplImage a c d -> (Ptr IplImage -> IO b) -> 
+                      (HIplImage FreshImage c d, b)
+withDuplicateImage img1 f = runST $ unsafeIOToST $
+                            do img2 <- duplicateImage img1
+                               r <- withHIplImage img2 f
+                               return (img2, r)
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'HIplImage' of the same dimensions as the given
+-- 'HIplImage'.
+withCompatibleImage :: (HasChannels c, HasDepth d, Storable d) => 
+                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
+                       (HIplImage FreshImage c d, b)
+withCompatibleImage img1 f = runST $ unsafeIOToST $
+                             do img2 <- compatibleImage img1
+                                r <- withHIplImage img2 f
+                                return (img2, r)
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index bc25a71..10000b2 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,14 +6,13 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             LineType(..), RGB, drawLines, HIplImage, width, 
                             height, pixels, fromGrayPixels, fromColorPixels, 
                             fromFileGray, fromFileColor, toFile, findContours, 
-                            convertGrayToRGB, convertGrayToBGR, fromPtr, 
-                            convertRGBToGray, convertBGRToGray, isColor, isMono, 
-                            fromPixels, fromPixelsCopy)
+                            fromPtr, isColor, isMono, fromPixels, 
+                            fromPixelsCopy, module AI.CV.OpenCV.HighColorConv)
     where
-import AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
-import AI.CV.OpenCV.HIplImage
+import AI.CV.OpenCV.HighColorConv
+import AI.CV.OpenCV.HIplUtils
 import Control.Monad.ST (runST, unsafeIOToST)
 import Data.Word (Word8)
 import Foreign.Ptr
@@ -161,40 +160,7 @@ unsafeDrawLines col thick lineType lines img =
   drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
   #-}
 
--- |Convert the color model of an image.
-convertGrayToRGB :: (HasDepth d, Storable d) =>
-                    HIplImage a MonoChromatic d -> HIplImage FreshImage TriChromatic d
-convertGrayToRGB = convertColor cv_GRAY2RGB
-
-convertGrayToBGR :: (HasDepth d, Storable d) =>
-                    HIplImage a MonoChromatic d -> HIplImage FreshImage TriChromatic d
-convertGrayToBGR = convertColor cv_GRAY2BGR
-
-convertBGRToGray :: (HasDepth d, Storable d) =>
-                    HIplImage a TriChromatic d -> HIplImage FreshImage MonoChromatic d
-convertBGRToGray = convertColor cv_BGR2GRAY
-
-convertRGBToGray :: (HasDepth d, Storable d) =>
-                    HIplImage a TriChromatic d -> HIplImage FreshImage MonoChromatic d
-convertRGBToGray = convertBGRToGray
-
-convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, Storable d) =>
-                ColorConversion -> HIplImage a c1 d -> HIplImage FreshImage c2 d
-convertColor cc img = runST $ unsafeIOToST $ 
-                      withHIplImage img $
-                        \src -> do dst <- mkHIplImage w h
-                                   withHIplImage dst $
-                                     \dst' -> cvCvtColor src dst' cc
-                                   return dst
-    where w = width img
-          h = height img
-          -- destChannels = [(cv_RGB2BGR, 3), (cv_BGR2GRAY, 1), (cv_GRAY2BGR, 3)]
-          -- nc = case lookup cc destChannels of
-          --        Just n -> n
-          --        Nothing -> error $ "Unfamiliar color conversion. "++
-          --                           "Contact maintainer."
-
 -- |Find the 'CvContour's in an image.
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $
-                     \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
\ No newline at end of file
+                     \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
diff --git a/src/AI/CV/OpenCV/HighColorConv.hs b/src/AI/CV/OpenCV/HighColorConv.hs
new file mode 100644
index 0000000..de3621f
--- /dev/null
+++ b/src/AI/CV/OpenCV/HighColorConv.hs
@@ -0,0 +1,41 @@
+-- |Type-safe color conversion functions. 
+module AI.CV.OpenCV.HighColorConv 
+    (convertGrayToRGB, convertGrayToBGR, 
+     convertBGRToGray, convertRGBToGray) where
+import AI.CV.OpenCV.CV
+import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.ColorConversion
+import Control.Monad.ST (runST, unsafeIOToST)
+import Foreign.Storable (Storable)
+
+convertGrayToRGB :: (HasDepth d, Storable d) =>
+                    HIplImage a MonoChromatic d -> 
+                    HIplImage FreshImage TriChromatic d
+convertGrayToRGB = convertColor cv_GRAY2RGB
+
+convertGrayToBGR :: (HasDepth d, Storable d) =>
+                    HIplImage a MonoChromatic d -> 
+                    HIplImage FreshImage TriChromatic d
+convertGrayToBGR = convertColor cv_GRAY2BGR
+
+convertBGRToGray :: (HasDepth d, Storable d) =>
+                    HIplImage a TriChromatic d -> 
+                    HIplImage FreshImage MonoChromatic d
+convertBGRToGray = convertColor cv_BGR2GRAY
+
+convertRGBToGray :: (HasDepth d, Storable d) =>
+                    HIplImage a TriChromatic d -> 
+                    HIplImage FreshImage MonoChromatic d
+convertRGBToGray = convertBGRToGray
+
+-- |Convert the color model of an image.
+convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, Storable d) =>
+                ColorConversion -> HIplImage a c1 d -> HIplImage FreshImage c2 d
+convertColor cc img = runST $ unsafeIOToST $ 
+                      withHIplImage img $
+                        \src -> do dst <- mkHIplImage w h
+                                   withHIplImage dst $
+                                     \dst' -> cvCvtColor src dst' cc
+                                   return dst
+    where w = width img
+          h = height img
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index b7bfa01..98c3015 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -5,6 +5,7 @@
 -- and to drop the unused packing bytes.
 module AI.CV.OpenCV.PixelUtils where
 import AI.CV.OpenCV.HIplImage
+import AI.CV.OpenCV.HIplUtils
 import Control.Monad.ST (runST)
 import Data.Vector.Storable (Storable)
 import qualified Data.Vector.Storable as V

From 874a91e8c8f02e5e007bef4a95239fe768008339 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 19:21:46 -0400
Subject: [PATCH 023/137] Added the packPixels function.

This replaces the old dropAlpha as it is faster and more general.
The idea is to trim OpenCV images that have a stride that is
larger than strictly necessary. Such images have their valid
pixel data copied and placed into a Vector that can be sent
on the network faster than the padded version.
---
 src/AI/CV/OpenCV/HIplImage.hsc |  5 ++++-
 src/AI/CV/OpenCV/PixelUtils.hs | 39 ++++++++++++++++++++++++++++------
 2 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 89c2f84..b81ce2e 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,5 +1,8 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
-module AI.CV.OpenCV.HIplImage where
+module AI.CV.OpenCV.HIplImage 
+    ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth, 
+      HIplImage(..), width, height, imageData, imageSize, widthStep, 
+      mkHIplImage, withHIplImage ) where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u)
 import AI.CV.OpenCV.CV (cvCvtColor)
 import AI.CV.OpenCV.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 98c3015..5623eaa 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -36,12 +36,37 @@ toRGB' :: Storable d => HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
 toRGB' img inds = V.backpermute (pixels img) inds
 {-# INLINE toRGB' #-}
 
--- |Drop any pixels beyond real image data on each row.
-dropAlpha :: V.Storable a => Int -> V.Vector a -> V.Vector a
-dropAlpha w = V.ifilter (\i _ -> (i `rem` rowLength) < realWidth)
-    where rowLength = w * 4
-          realWidth = w * 3
-{-# INLINE dropAlpha #-}
+-- |OpenCV often stores color images with rows that are four times the
+-- width (which aligns rows nicely, and can accommodate RGBA
+-- pixels). For network transmission, it can be advantageous to strip
+-- out that extra data. This function returns a fresh 'V.Vector' of
+-- pixel data that excludes these unused bytes. If the original image
+-- data is already packed, it is returned as a 'V.Vector' without
+-- copying.
+packPixels :: (HasChannels c, HasDepth d, Storable d) => 
+              HIplImage a c d -> V.Vector d
+packPixels img = 
+    if w' == stride 
+    then pixels img
+    else runST $ do v <- VM.new (w*h*nc)
+                    let sliceSrc x = V.unsafeSlice x w' pix
+                        sliceDst x = VM.unsafeSlice x w' v
+                        go !y !pSrc !pDst
+                            | y < h = let s1 = sliceSrc pSrc
+                                          s2 = sliceDst pDst
+                                          pSrc' = pSrc + stride
+                                          pDst' = pDst + w'
+                                      in do V.unsafeCopy s2 s1
+                                            go (y+1) pSrc' pDst'
+                            | otherwise = VG.unsafeFreeze v
+                    go 0 0 0
+    where w = width img
+          h = height img
+          nc = imgChannels img
+          w' = w * nc
+          stride = widthStep img
+          pix = pixels img
+{-# INLINE packPixels #-}
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
@@ -66,7 +91,7 @@ isolateChannel ch img =
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
 toMono :: forall a c d. (HasChannels c, HasDepth d, Storable d, Integral d) => 
           HIplImage a c d -> V.Vector d
-toMono img = if imgChannels img == 1 then dropAlpha w pix 
+toMono img = if imgChannels img == 1 then packPixels img
              else runST $ do v <- VM.new (w*h)
                              let go !x !p !p3 !y
                                      | y >= h = VG.unsafeFreeze v

From 4fdda6712d4035eab95d62713ebc8e905900ad82 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 20:09:43 -0400
Subject: [PATCH 024/137] Added support for cvSampleLine.

Returns a list of pixel values (of the appropriate depth and number of
channels) sampled from a line in an image.
---
 src/AI/CV/OpenCV/CV.hsc    | 34 ++++++++++++++++++++++++++++++----
 src/AI/CV/OpenCV/HighCV.hs | 14 ++++++++++++--
 2 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index b9416b9..1f5bd45 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables #-}
 -- |Support for features from the OpenCV Image Filtering library.
 module AI.CV.OpenCV.CV 
     ( InterpolationMethod(..),
@@ -7,12 +7,14 @@ module AI.CV.OpenCV.CV
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
       combineHaarFlags, cvHaarDetectObjects,
-      cvCvtColor, cvFindContours, ContourMethod(..), ContourMode(..)
+      cvCvtColor, cvFindContours, ContourMethod(..), ContourMode(..),
+      cvSampleLine, Connectivity(..)
     ) where
 
 import Foreign.C.Types
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Storable (poke, peek, peekByteOff)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Marshal.Array (peekArray)
+import Foreign.Storable (poke, peek, peekByteOff, Storable(..))
 import Foreign.Ptr
 import Data.Bits
 import AI.CV.OpenCV.CxCore
@@ -73,6 +75,30 @@ cvHoughLines2 img storage method rho theta threshold param1 param2 =
 foreign import ccall unsafe "opencv/cv.h cvCvtColor"
   c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
+foreign import ccall unsafe "opencv/cv.h cvSampleLine"
+  c_cvSampleLine :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> Ptr a -> 
+                    CInt -> IO CInt
+
+-- |Line connectivity used for sampling.
+data Connectivity = Four | Eight
+
+-- |Read all of the image points lying on the line between pt1 and
+-- pt2, including the end points. Takes an image, two points, and the
+-- line connectivity; returns all the pixel values along that line.
+cvSampleLine :: forall a b. (IplArrayType a, Storable b) => 
+                Ptr a -> (Int,Int) -> (Int,Int) -> Connectivity -> IO [b]
+cvSampleLine img (x1,y1) (x2,y2) c = 
+    do nc <- getNumChannels (castPtr img)
+       allocaBytes (sz'*nc) $ 
+         \buffer -> do n <- c_cvSampleLine (fromArr img) (fi x1) (fi y1) 
+                                           (fi x2) (fi y2) buffer c'
+                       peekArray ((fromIntegral n)*nc) buffer
+  where fi = fromIntegral
+        (sz,c') = case c of
+                    Four -> (abs (x2 - x1) + abs (y2 - y1) + 1, 4)
+                    Eight -> (max (abs (x2 - x1) + 1) (abs (y2 - y1) + 1), 8)
+        sz' = sizeOf (undefined::b) * sz
+
 -- |Convert the color of the first 'IplImage', storing the result in
 -- the second. The second image must have the same dimensions as the
 -- first and the same depth, but it's number of color channels may be
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 10000b2..c19972e 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,8 +6,9 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             LineType(..), RGB, drawLines, HIplImage, width, 
                             height, pixels, fromGrayPixels, fromColorPixels, 
                             fromFileGray, fromFileColor, toFile, findContours, 
-                            fromPtr, isColor, isMono, fromPixels, 
-                            fromPixelsCopy, module AI.CV.OpenCV.HighColorConv)
+                            fromPtr, isColor, isMono, fromPixels, sampleLine,
+                            Connectivity(..), fromPixelsCopy, 
+                            module AI.CV.OpenCV.HighColorConv)
     where
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
@@ -72,6 +73,15 @@ unsafeDilate n img = runST $
 "dilate-in-place" forall n (f::a -> HIplImage FreshImage c d). dilate n . f = unsafeDilate n . f
   #-}
 
+-- |Extract all the pixel values from an image along a line, including
+-- the end points. Takes two points, the line connectivity to use when
+-- sampling, and an image; returns the list of pixel values.
+sampleLine :: (HasChannels c, HasDepth d, Storable d) =>
+              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage a c d -> [d]
+sampleLine pt1 pt2 conn img = runST $ unsafeIOToST $ 
+                              withHIplImage img $ 
+                                \p -> cvSampleLine p pt1 pt2 conn
+
 -- |Line detection in a binary image using a standard Hough transform.
 houghStandard :: Double -> Double -> Int -> HIplImage a MonoChromatic Word8 -> 
                  [((Int, Int),(Int,Int))]

From 6ed2f1e9c4f3d36aa9ea6dd9c7f08583cbddc0ef Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 5 Aug 2010 20:11:04 -0400
Subject: [PATCH 025/137] Added a .gitignore file.

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1521c8b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist

From 9cd08faa361ed4efd596e89f7103ecd323cc9320 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 6 Aug 2010 21:10:07 -0400
Subject: [PATCH 026/137] Added a file existence check to the fromFile*
 functions.

---
 src/AI/CV/OpenCV/HIplUtils.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
index 1160579..1d40e99 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -18,6 +18,7 @@ import Foreign.ForeignPtr
 import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr
 import Foreign.Storable
+import System.Directory (doesFileExist)
 import Unsafe.Coerce
 
 -- |This is a way to let the type checker know that you belieave an
@@ -61,11 +62,16 @@ fromPtr :: (HasChannels c, HasDepth d, Storable d) =>
            Ptr IplImage -> IO (HIplImage () c d)
 fromPtr = peek . castPtr
 
+-- Ensure that a file exists.
+checkFile :: FilePath -> IO ()
+checkFile f = do e <- doesFileExist f
+                 if e then return () else error $ "Can't find "++f
+
 -- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
 -- image will have three color channels.
 fromFileColor :: String -> IO (HIplImage FreshImage TriChromatic Word8)
---fromFileColor fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadColor 
-fromFileColor fileName = do ptr <- cvLoadImage fileName LoadColor
+fromFileColor fileName = do checkFile fileName
+                            ptr <- cvLoadImage fileName LoadColor
                             img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
                             return $ unsafeCoerce img
 
@@ -73,7 +79,8 @@ fromFileColor fileName = do ptr <- cvLoadImage fileName LoadColor
 -- image will have a single color channel.
 fromFileGray :: String -> IO (HIplImage FreshImage MonoChromatic Word8)
 --fromFileGray fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadGray
-fromFileGray fileName = do ptr <- cvLoadImage fileName LoadGray
+fromFileGray fileName = do checkFile fileName
+                           ptr <- cvLoadImage fileName LoadGray
                            img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
                            return $ unsafeCoerce img
 

From b4fcb6cb60cda5771b5c5e58d0dc2902ab495c03 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 6 Aug 2010 21:10:24 -0400
Subject: [PATCH 027/137] Wrapped Canny edge detection up into HighCV.

---
 HOpenCV.cabal              |  3 ++-
 src/AI/CV/OpenCV/CV.hsc    |  4 ++--
 src/AI/CV/OpenCV/HighCV.hs | 14 +++++++++++++-
 3 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 6e6e43b..0135057 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -32,14 +32,15 @@ library
       AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
+      AI.CV.OpenCV.HighColorConv
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
    extra-libraries: cxcore,cv,highgui
-   other-modules: AI.CV.OpenCV.HighColorConv
    build-depends: base >=4 && <5, 
                   allocated-processor >= 0.0.1, 
                   vector-space,
+                  directory >= 1.0.1.0 && < 1.1,
                   vector >= 0.6.0.2 && < 0.7
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing
 
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index 1f5bd45..bfc9a8d 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -27,10 +27,10 @@ foreign import ccall unsafe "opencv/cv.h cvCanny"
 
 -- Canny 
 cvCanny :: (IplArrayType i1, IplArrayType i2) =>
-           Ptr i1 -> Ptr i2 -> CDouble -> CDouble -> CInt -> IO ()
+           Ptr i1 -> Ptr i2 -> Double -> Double -> Int -> IO ()
 cvCanny src dst threshold1 threshold2 apertureSize = 
   c_cvCanny (fromArr src) (fromArr dst) (realToFrac threshold1) 
-            (realToFrac threshold2) apertureSize
+            (realToFrac threshold2) (fromIntegral apertureSize)
 
 
 data InterpolationMethod = CV_INTER_NN 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index c19972e..5622a91 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -7,7 +7,7 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             height, pixels, fromGrayPixels, fromColorPixels, 
                             fromFileGray, fromFileColor, toFile, findContours, 
                             fromPtr, isColor, isMono, fromPixels, sampleLine,
-                            Connectivity(..), fromPixelsCopy, 
+                            Connectivity(..), fromPixelsCopy, cannyEdges,
                             module AI.CV.OpenCV.HighColorConv)
     where
 import AI.CV.OpenCV.CxCore
@@ -170,6 +170,18 @@ unsafeDrawLines col thick lineType lines img =
   drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
   #-}
 
+-- |Find edges using the Canny algorithm. The smallest value between
+-- threshold1 and threshold2 is used for edge linking, the largest
+-- value is used to find the initial segments of strong edges. The
+-- third parameter is the aperture parameter for the Sobel operator.
+cannyEdges :: (HasDepth d, Storable d) =>
+              Double -> Double -> Int -> HIplImage a MonoChromatic d -> 
+              HIplImage FreshImage MonoChromatic d
+cannyEdges threshold1 threshold2 aperture img = 
+    fst . withCompatibleImage img $ \dst -> 
+        withHIplImage img $ \src -> 
+            cvCanny src dst threshold1 threshold2 aperture
+
 -- |Find the 'CvContour's in an image.
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $

From 6a672f1720d42c9b8dc81a2385d327e24f710fd5 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 13 Aug 2010 19:55:12 -0400
Subject: [PATCH 028/137] Wrapped cvCalcOpticalFlowBM.

- Improved video capture from file interface.
- Fixed bug in mkHIplImage related to the new image's size.
- Fixed support for HIplImage's with floating point data.
---
 HOpenCV.cabal                  |  1 +
 src/AI/CV/OpenCV/HIplImage.hsc | 19 ++++++++++++-------
 src/AI/CV/OpenCV/HIplUtils.hs  |  9 +++++----
 src/AI/CV/OpenCV/HighCV.hs     | 25 +++++++++++++++++++++++++
 src/AI/CV/OpenCV/HighGui.hs    |  3 ++-
 src/AI/CV/OpenCV/PixelUtils.hs |  8 +++++---
 6 files changed, 50 insertions(+), 15 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 0135057..dfb902f 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -33,6 +33,7 @@ library
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
       AI.CV.OpenCV.HighColorConv
+      AI.CV.OpenCV.Motion
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index b81ce2e..028c70c 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -2,12 +2,14 @@
 module AI.CV.OpenCV.HIplImage 
     ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth, 
       HIplImage(..), width, height, imageData, imageSize, widthStep, 
-      mkHIplImage, withHIplImage ) where
-import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u)
+      mkHIplImage, withHIplImage, bytesPerPixel) where
+import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
+                            iplDepth32f, iplDepth64f)
 import AI.CV.OpenCV.CV (cvCvtColor)
 import AI.CV.OpenCV.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
+import Data.Bits (complement, (.&.))
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
@@ -65,9 +67,12 @@ instance HasChannels TriChromatic where numChannels _ = 3
 instance HasChannels MonoChromatic where numChannels _ = 1
 instance HasDepth Word8 where depth _ = iplDepth8u
 instance HasDepth Word16 where depth _ = iplDepth16u
+instance HasDepth Float where depth _ = iplDepth32f
+instance HasDepth Double where depth _ = iplDepth64f
 
-bytesPerPixel :: Depth -> Int
-bytesPerPixel = (`div` 8) . fromIntegral . unDepth
+bytesPerPixel :: HasDepth d => d -> Int
+bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
+    where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
 
 -- |A Haskell data structure representing the information OpenCV uses
 -- from an 'IplImage' struct. It includes the pixel origin, image
@@ -95,9 +100,9 @@ mkHIplImage :: forall c d. (HasChannels c, HasDepth d, Storable d) =>
 mkHIplImage w h = 
     do ptr <- mallocForeignPtrArray numBytes
        return $ HIplImage 0 w h numBytes ptr stride
-    where numBytes = stride * h * bpp
-          bpp = bytesPerPixel (depth (undefined::d))
-          stride = w * (numChannels (undefined::c) :: Int)
+    where numBytes = stride * h
+          bpp = bytesPerPixel (undefined::d)
+          stride = w * (numChannels (undefined::c) :: Int) * bpp
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
index 1d40e99..9674be4 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -38,10 +38,11 @@ imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
 -- |Return a 'V.Vector' containing the pixels that make up an
--- 8-bit-per-pixel 'HIplImage'. This does not copy the underlying
--- data!
-pixels :: Storable d => HIplImage a c d -> V.Vector d
-pixels img = V.unsafeFromForeignPtr (imageData img) 0 (imageSize img)
+-- 'HIplImage'. This does not copy the underlying data!
+pixels :: forall a c d. (HasDepth d, Storable d) => 
+          HIplImage a c d -> V.Vector d
+pixels img = V.unsafeFromForeignPtr (imageData img) 0 n
+    where n = imageSize img `div` bytesPerPixel (undefined::d)
 
 doST :: IO a -> a
 doST x = runST (unsafeIOToST x)
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 5622a91..80ad2e0 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -8,15 +8,19 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             fromFileGray, fromFileColor, toFile, findContours, 
                             fromPtr, isColor, isMono, fromPixels, sampleLine,
                             Connectivity(..), fromPixelsCopy, cannyEdges,
+                            createFileCapture, resize, InterpolationMethod(..),
+                            MonoChromatic, TriChromatic, FreshImage,
                             module AI.CV.OpenCV.HighColorConv)
     where
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HighColorConv
+import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame)
 import AI.CV.OpenCV.HIplUtils
 import Control.Monad.ST (runST, unsafeIOToST)
 import Data.Word (Word8)
 import Foreign.Ptr
+import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
 import Unsafe.Coerce
 
@@ -186,3 +190,24 @@ cannyEdges threshold1 threshold2 aperture img =
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
+
+-- |Open a capture stream from a movie file. The action returned may
+-- be used to query for the next available frame.
+createFileCapture :: (HasChannels c, HasDepth d, Storable d) =>
+                     FilePath -> IO (IO (HIplImage () c d))
+createFileCapture fname = do capture <- createFileCaptureF fname
+                             return (withForeignPtr capture $ 
+                                     (>>= fromPtr) . cvQueryFrame)
+
+-- |Resize the supplied 'HIplImage' to the given width and height using
+-- the supplied 'InterpolationMethod'.
+resize :: (HasChannels c, HasDepth d, Storable d) => 
+          InterpolationMethod -> Int -> Int -> HIplImage a c d -> 
+          HIplImage FreshImage c d
+resize method w h img = 
+    runST $ unsafeIOToST $
+    do img' <- mkHIplImage w h
+       _ <- withHIplImage img $ \src ->
+              withHIplImage img' $ \dst ->
+                cvResize src dst method
+       return img'
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index a9bbe5d..d50f9e7 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -72,7 +72,8 @@ foreign import ccall unsafe "HOpenCV_wrap.h &release_capture"
 createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture)
 createCameraCaptureF = (createForeignPtr cp_release_capture) . cvCreateCameraCapture
 
-
+createFileCaptureF :: String -> IO (ForeignPtr CvCapture)
+createFileCaptureF = (createForeignPtr cp_release_capture) . cvCreateFileCapture
 
 foreign import ccall unsafe "highgui.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 5623eaa..73fe53f 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -23,7 +23,7 @@ rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
 
 -- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded rows
 -- to tightly packed rows of RGB pixels.
-toRGB :: Storable d => HIplImage a TriChromatic d -> V.Vector d
+toRGB :: (HasDepth d, Storable d) => HIplImage a TriChromatic d -> V.Vector d
 toRGB img = V.backpermute (pixels img) $
             rgbIndices (width img) (widthStep img) (imageSize img)
 {-# INLINE toRGB #-}
@@ -32,7 +32,8 @@ toRGB img = V.backpermute (pixels img) $
 -- rows to tightly packed rows of RGB pixels using the given
 -- 'V.Vector' of indices. The index 'Vector' will typically be the
 -- result of a previous call to 'rgbIndices'.
-toRGB' :: Storable d => HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
+toRGB' :: (HasDepth d, Storable d) => 
+          HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
 toRGB' img inds = V.backpermute (pixels img) inds
 {-# INLINE toRGB' #-}
 
@@ -70,7 +71,8 @@ packPixels img =
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: Storable d => Int -> HIplImage a TriChromatic d -> V.Vector d
+isolateChannel :: (HasDepth d, Storable d) => 
+                  Int -> HIplImage a TriChromatic d -> V.Vector d
 isolateChannel ch img = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"

From 6593e136f2d26e5155550c5b41e09644636c534b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 13 Aug 2010 19:59:04 -0400
Subject: [PATCH 029/137] Added the actual cvCalcOpticalFlowBM wrapper
 implementation.

---
 src/AI/CV/OpenCV/Motion.hsc | 44 +++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/Motion.hsc

diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
new file mode 100644
index 0000000..bc22ee1
--- /dev/null
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -0,0 +1,44 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- |Motion analysis functions.
+module AI.CV.OpenCV.Motion (calcOpticalFlowBM) where
+import Data.Word (Word8)
+import Foreign.C.Types (CInt)
+import Foreign.Ptr (Ptr)
+import System.IO.Unsafe
+import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.HIplImage
+
+foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
+  c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
+                           CInt -> CInt -> CInt -> CInt -> 
+                           CInt -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Calculates the optical flow for two images by using the block
+-- matching method. The third parameter is the width and height of
+-- blocks to be compared; the fourth parameter is the block coordinate
+-- increments; the fifth is the size of the scanned neighborhood in
+-- pixels around the block. The result is a pair of the horizontal and
+-- vertical components of optical flow.
+calcOpticalFlowBM :: HIplImage a MonoChromatic Word8 -> 
+                     HIplImage b MonoChromatic Word8 -> 
+                     (Int,Int) -> (Int,Int) -> (Int,Int) -> 
+                     (HIplImage FreshImage MonoChromatic Float, 
+                      HIplImage FreshImage MonoChromatic Float)
+calcOpticalFlowBM prev curr blockSize shiftSize maxRange = 
+    unsafePerformIO $
+    do velX <- mkHIplImage w h 
+       velY <- mkHIplImage w h
+       withHIplImage prev $ \prevPtr ->
+         withHIplImage curr $ \currPtr ->
+           withHIplImage velX $ \vxPtr ->
+             withHIplImage velY $ \vyPtr -> 
+                  c_cvCalcOpticalFlowBM (fromArr prevPtr) (fromArr currPtr) 
+                                        (sw blockSize) (sh blockSize)
+                                        (sw shiftSize) (sh shiftSize)
+                                        (sw maxRange) (sh maxRange)
+                                        0 (fromArr vxPtr) (fromArr vyPtr)
+       return (velX, velY)
+    where w = (width prev - fst blockSize) `div` fst shiftSize
+          h = (height prev - snd blockSize) `div` snd shiftSize
+          sw = fromIntegral . fst -- size width
+          sh = fromIntegral . snd -- size height

From 52a1cec0ac509ff12ca956eb5a13263c737b7fee Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 16 Aug 2010 15:14:08 -0400
Subject: [PATCH 030/137] Extracted findContours into its own module.

---
 HOpenCV.cabal                 |   1 +
 src/AI/CV/OpenCV/CV.hsc       |  96 ++------------------------------
 src/AI/CV/OpenCV/Contours.hsc | 102 ++++++++++++++++++++++++++++++++++
 src/AI/CV/OpenCV/HighCV.hs    |   1 +
 4 files changed, 108 insertions(+), 92 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/Contours.hsc

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index dfb902f..310ad19 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -34,6 +34,7 @@ library
       AI.CV.OpenCV.ColorConversion
       AI.CV.OpenCV.HighColorConv
       AI.CV.OpenCV.Motion
+      AI.CV.OpenCV.Contours
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index bfc9a8d..c2135bb 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -7,14 +7,14 @@ module AI.CV.OpenCV.CV
       cvHaarFlagNone, cvHaarDoCannyPruning, 
       cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
       combineHaarFlags, cvHaarDetectObjects,
-      cvCvtColor, cvFindContours, ContourMethod(..), ContourMode(..),
+      cvCvtColor,
       cvSampleLine, Connectivity(..)
     ) where
 
 import Foreign.C.Types
-import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Marshal.Array (peekArray)
-import Foreign.Storable (poke, peek, peekByteOff, Storable(..))
+import Foreign.Storable (Storable, sizeOf)
 import Foreign.Ptr
 import Data.Bits
 import AI.CV.OpenCV.CxCore
@@ -109,94 +109,6 @@ cvCvtColor :: (IplArrayType a, IplArrayType b) =>
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
 
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
-  c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> Int -> Int -> Int -> Int -> Int -> IO Int
-
--- |Contour extraction mode.
-data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme
-                                    -- outer contours
-
-                 | CV_RETR_LIST     -- ^retrieves all of the contours
-                                    -- and puts them in the list
-
-                 | CV_RETR_CCOMP    -- ^retrieves all of the contours
-                                    -- and organizes them into a
-                                    -- two-level hierarchy: on the top
-                                    -- level are the external
-                                    -- boundaries of the components,
-                                    -- on the second level are the
-                                    -- boundaries of the holes
-
-                 | CV_RETR_TREE     -- ^retrieves all of the contours
-                                    -- and reconstructs the full
-                                    -- hierarchy of nested contours
-                   deriving (Enum, Eq)
-
-data ContourMethod = CV_CHAIN_APPROX_NONE      
-                   -- ^translates all of the points from the chain
-                   -- code into points
-
-                   | CV_CHAIN_APPROX_SIMPLE    
-                   -- ^compresses horizontal, vertical, and diagonal
-                   -- segments and leaves only their end points
-
-                   | CV_CHAIN_APPROX_TC89_L1   
-                   -- ^applies one of the flavors of the Teh-Chin
-                   -- chain approximation algorithm
-
-                   | CV_CHAIN_APPROX_TC89_KCOS
-                   -- ^applies one of the flavors of the Teh-Chin
-                   -- chain approximation algorithm
-
-                   | CV_LINK_RUNS
-                   -- ^uses a completely different contour retrieval
-                   -- algorithm by linking horizontal segments of
-                   -- 1's. Only the CV_RETR_LIST retrieval mode can be
-                   -- used with this method.  
-
-                   -- | CV_CHAIN_CODE -- changes returned sequence type
-                     deriving Enum
-
--- |The function retrieves 'CvContour's from the binary image using the
--- algorithm Suzuki85. The contours are a useful tool for shape
--- analysis and object detection and recognition.
-cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour]
-cvFindContours img mode method = 
-    do storage <- cvCreateMemStorage 0
-       let header = case method of
-                      --CV_CHAIN_CODE -> (#size CvChain)
-                      _ -> (#size CvContour)
-           mode' = fromEnum mode
-           method' = case method of 
-                       CV_LINK_RUNS -> if mode == CV_RETR_LIST
-                                       then fromEnum method
-                                       else error $ "CV_LINK_RUNS can only be "++
-                                                    "used with CV_RETR_LIST"
-                       _ -> fromEnum method
-       cs <- alloca $ \cseq ->
-               do _n <- alloca $ \cseq' ->
-                          poke (cseq'::Ptr (Ptr CInt)) cseq >>
-                          c_cvFindContours (fromArr img) storage (castPtr cseq')
-                                           header mode' method' 0 0
-                  putStrLn $ "Found "++show _n++" contours"
-                  followContourList (castPtr cseq)
-       cvReleaseMemStorage storage
-       return cs
-
--- FIXME: This is wrong. We're actually getting an array of arrays of
--- Points. Check the cvDrawContours function to see how to interpret
--- the result of c_cvFindContours.
-followContourList :: Ptr (CvSeq CvContour) -> IO [CvContour]
-followContourList = go []
-    where go acc p = if p == nullPtr
-                     then return $ reverse acc
-                     else do putStrLn "Getting element 1"
-                             n <- seqNumElems p
-                             putStrLn $ "Initial seq has "++show n++" elems"
-                             x <- peek =<< cvGetSeqElem p 1
-                             putStrLn $ "Found " ++ show x
-                             p' <- (#peek CvSeq, h_next) p
-                             go (x:acc) p'
 
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
@@ -247,4 +159,4 @@ cvHaarDetectObjects :: (IplArrayType i) =>
                         -> 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)
-  
\ No newline at end of file
+  
diff --git a/src/AI/CV/OpenCV/Contours.hsc b/src/AI/CV/OpenCV/Contours.hsc
new file mode 100644
index 0000000..ae72a77
--- /dev/null
+++ b/src/AI/CV/OpenCV/Contours.hsc
@@ -0,0 +1,102 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- |Incomplete support for cvFindContours.
+module AI.CV.OpenCV.Contours (ContourMode(..), ContourMethod(..), 
+                              cvFindContours, followContourList) where
+import AI.CV.OpenCV.CxCore
+import Foreign.C.Types (CInt)
+import Foreign.Ptr (Ptr, castPtr, nullPtr)
+import Foreign.Storable
+import Foreign.Marshal.Alloc (alloca)
+
+#include <opencv/cv.h>
+
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
+  c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> 
+                      Int -> Int -> Int -> Int -> Int -> IO Int
+
+-- |Contour extraction mode.
+data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme
+                                    -- outer contours
+
+                 | CV_RETR_LIST     -- ^retrieves all of the contours
+                                    -- and puts them in the list
+
+                 | CV_RETR_CCOMP    -- ^retrieves all of the contours
+                                    -- and organizes them into a
+                                    -- two-level hierarchy: on the top
+                                    -- level are the external
+                                    -- boundaries of the components,
+                                    -- on the second level are the
+                                    -- boundaries of the holes
+
+                 | CV_RETR_TREE     -- ^retrieves all of the contours
+                                    -- and reconstructs the full
+                                    -- hierarchy of nested contours
+                   deriving (Enum, Eq)
+
+data ContourMethod = CV_CHAIN_APPROX_NONE      
+                   -- ^translates all of the points from the chain
+                   -- code into points
+
+                   | CV_CHAIN_APPROX_SIMPLE    
+                   -- ^compresses horizontal, vertical, and diagonal
+                   -- segments and leaves only their end points
+
+                   | CV_CHAIN_APPROX_TC89_L1   
+                   -- ^applies one of the flavors of the Teh-Chin
+                   -- chain approximation algorithm
+
+                   | CV_CHAIN_APPROX_TC89_KCOS
+                   -- ^applies one of the flavors of the Teh-Chin
+                   -- chain approximation algorithm
+
+                   | CV_LINK_RUNS
+                   -- ^uses a completely different contour retrieval
+                   -- algorithm by linking horizontal segments of
+                   -- 1's. Only the CV_RETR_LIST retrieval mode can be
+                   -- used with this method.  
+
+                   -- | CV_CHAIN_CODE -- changes returned sequence type
+                     deriving Enum
+
+-- |The function retrieves 'CvContour's from the binary image using the
+-- algorithm Suzuki85. The contours are a useful tool for shape
+-- analysis and object detection and recognition.
+cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour]
+cvFindContours img mode method = 
+    do storage <- cvCreateMemStorage 0
+       let header = case method of
+                      --CV_CHAIN_CODE -> (#size CvChain)
+                      _ -> (#size CvContour)
+           mode' = fromEnum mode
+           method' = case method of 
+                       CV_LINK_RUNS -> if mode == CV_RETR_LIST
+                                       then fromEnum method
+                                       else error $ "CV_LINK_RUNS can only be "++
+                                                    "used with CV_RETR_LIST"
+                       _ -> fromEnum method
+       cs <- alloca $ \cseq ->
+               do _n <- alloca $ \cseq' ->
+                          poke (cseq'::Ptr (Ptr CInt)) cseq >>
+                          c_cvFindContours (fromArr img) storage (castPtr cseq')
+                                           header mode' method' 0 0
+                  putStrLn $ "Found "++show _n++" contours"
+                  followContourList (castPtr cseq)
+       cvReleaseMemStorage storage
+       return cs
+
+-- FIXME: This is wrong. We're actually getting an array of arrays of
+-- Points. Check the cvDrawContours function to see how to interpret
+-- the result of c_cvFindContours.
+followContourList :: Ptr (CvSeq CvContour) -> IO [CvContour]
+followContourList = go []
+    where go acc p = if p == nullPtr
+                     then return $ reverse acc
+                     else do putStrLn "Getting element 1"
+                             n <- seqNumElems p
+                             putStrLn $ "Initial seq has "++show n++" elems"
+                             x <- peek =<< cvGetSeqElem p 1
+                             putStrLn $ "Found " ++ show x
+                             p' <- (#peek CvSeq, h_next) p
+                             go (x:acc) p'
+
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 80ad2e0..06ee742 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -17,6 +17,7 @@ import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HighColorConv
 import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame)
 import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Contours
 import Control.Monad.ST (runST, unsafeIOToST)
 import Data.Word (Word8)
 import Foreign.Ptr

From 102cd69a81ec584a083f12c27ed3b86d71f3f560 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 16 Aug 2010 18:38:15 -0400
Subject: [PATCH 031/137] Added image thresholding operations.

- Basic image threshold operations with expressive types.
- Also started adding some array operations, but barely scratched
  the surface of these.
---
 HOpenCV.cabal                  |   2 +
 src/AI/CV/OpenCV/ArrayOps.hs   |  97 ++++++++++++++++
 src/AI/CV/OpenCV/CV.hsc        |   2 -
 src/AI/CV/OpenCV/HIplImage.hsc |  32 ++++--
 src/AI/CV/OpenCV/HIplUtils.hs  |   3 +-
 src/AI/CV/OpenCV/Threshold.hs  | 200 +++++++++++++++++++++++++++++++++
 6 files changed, 326 insertions(+), 10 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/ArrayOps.hs
 create mode 100644 src/AI/CV/OpenCV/Threshold.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 310ad19..fe96cde 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -35,6 +35,8 @@ library
       AI.CV.OpenCV.HighColorConv
       AI.CV.OpenCV.Motion
       AI.CV.OpenCV.Contours
+      AI.CV.OpenCV.Threshold
+      AI.CV.OpenCV.ArrayOps
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
new file mode 100644
index 0000000..6df9529
--- /dev/null
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff) where
+import Foreign.C.Types (CDouble)
+import Foreign.Ptr (Ptr, castPtr, nullPtr)
+import Foreign.Storable (Storable)
+import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.CxCore (CvArr)
+import AI.CV.OpenCV.HIplUtils
+
+foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
+  c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+               Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
+subRS :: (HasDepth d, Storable d) =>
+         d -> HIplImage a MonoChromatic d -> 
+         HIplImage FreshImage MonoChromatic d
+subRS value src = unsafePerformIO $ 
+                  withHIplImage src $ \srcPtr ->
+                    return . fst . withCompatibleImage src $ \dstPtr -> 
+                      c_cvSubRS (castPtr srcPtr) v v v v (castPtr dstPtr) 
+                                nullPtr
+    where v = realToFrac . toDouble $ value
+
+-- Unsafe in-place pointwise subtraction of each pixel from a given
+-- scalar value.
+unsafeSubRS :: (HasDepth d, Storable d) =>
+               d -> HIplImage FreshImage MonoChromatic d ->
+               HIplImage FreshImage MonoChromatic d
+unsafeSubRS value src = unsafePerformIO $
+                        withHIplImage src $ \srcPtr ->
+                            do c_cvSubRS (castPtr srcPtr) v v v v 
+                                         (castPtr srcPtr) nullPtr
+                               return src
+    where v = realToFrac . toDouble $ value
+
+{-# RULES "subRS-in-place" forall v (f::a -> HIplImage FreshImage MonoChromatic d). 
+    subRS v . f = unsafeSubRS v . f
+  #-}
+
+-- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
+subRSVec :: (HasDepth d, Storable d) =>
+            (d,d,d) -> HIplImage a TriChromatic d ->
+            HIplImage FreshImage TriChromatic d
+subRSVec (r,g,b) src = unsafePerformIO $
+                       withHIplImage src $ \src' ->
+                         return . fst . withCompatibleImage src $ \dst' ->
+                           c_cvSubRS (castPtr src') r' g' b' 0 (castPtr dst')
+                                     nullPtr
+    where r' = realToFrac . toDouble $ r
+          g' = realToFrac . toDouble $ g
+          b' = realToFrac . toDouble $ b
+
+unsafeSubRSVec :: (HasDepth d, Storable d) =>
+                  (d,d,d) -> HIplImage FreshImage TriChromatic d ->
+                  HIplImage FreshImage TriChromatic d
+unsafeSubRSVec (r,g,b) src = unsafePerformIO $
+                             withHIplImage src $ \src' ->
+                                 do c_cvSubRS (castPtr src') r' g' b' 0 
+                                              (castPtr src') nullPtr
+                                    return src
+    where r' = realToFrac . toDouble $ r
+          g' = realToFrac . toDouble $ g
+          b' = realToFrac . toDouble $ b
+
+{-# RULES "subRSVec-inplace" 
+  forall v (g::a->HIplImage FreshImage TriChromatic d).
+  subRSVec v . g = unsafeSubRSVec v . g
+  #-}
+
+foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
+  c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Calculate the absolute difference between two images.
+absDiff :: (HasChannels c, HasDepth d, Storable d) => 
+           HIplImage a c d -> HIplImage a c d -> HIplImage FreshImage c d
+absDiff src1 src2 = unsafePerformIO $
+                    withHIplImage src1 $ \src1' ->
+                      withHIplImage src2 $ \src2' ->
+                        return . fst . withCompatibleImage src1 $ \dst ->
+                          c_cvAbsDiff (castPtr src1') (castPtr src2') 
+                                      (castPtr dst)
+
+unsafeAbsDiff :: (HasChannels c, HasDepth d, Storable d) => 
+                 HIplImage a c d -> HIplImage FreshImage c d -> 
+                 HIplImage FreshImage c d
+unsafeAbsDiff src1 src2 = unsafePerformIO $
+                          withHIplImage src1 $ \src1' ->
+                            withHIplImage src2 $ \src2' ->
+                                do c_cvAbsDiff (castPtr src1') (castPtr src2') 
+                                               (castPtr src2')
+                                   return src2
+
+{-# RULES "absDiff-inplace"
+  forall m1 (g::a -> HIplImage FreshImage c d). 
+  absDiff m1 . g = unsafeAbsDiff m1 . g
+  #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc
index c2135bb..03dc147 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/CV.hsc
@@ -108,8 +108,6 @@ cvCvtColor :: (IplArrayType a, IplArrayType b) =>
               Ptr a -> Ptr b -> ColorConversion -> IO ()
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
-
-
 foreign import ccall unsafe "opencv/cv.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/HIplImage.hsc
index 028c70c..435d8c3 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/HIplImage.hsc
@@ -1,8 +1,8 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
 module AI.CV.OpenCV.HIplImage 
-    ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth, 
+    ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), width, height, imageData, imageSize, widthStep, 
-      mkHIplImage, withHIplImage, bytesPerPixel) where
+      mkHIplImage, withHIplImage, bytesPerPixel, ByteOrFloat) where
 import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
                             iplDepth32f, iplDepth64f)
 import AI.CV.OpenCV.CV (cvCvtColor)
@@ -61,14 +61,32 @@ class HasChannels a where
     numChannels :: a -> Int
 
 class HasDepth a where
-    depth :: a -> Depth
+    depth    :: a -> Depth
+    toDouble :: a -> Double
+    fromDouble :: Double -> a
 
 instance HasChannels TriChromatic where numChannels _ = 3
 instance HasChannels MonoChromatic where numChannels _ = 1
-instance HasDepth Word8 where depth _ = iplDepth8u
-instance HasDepth Word16 where depth _ = iplDepth16u
-instance HasDepth Float where depth _ = iplDepth32f
-instance HasDepth Double where depth _ = iplDepth64f
+instance HasDepth Word8 where 
+    depth _ = iplDepth8u
+    toDouble = fromIntegral
+    fromDouble = round
+instance HasDepth Word16 where 
+    depth _ = iplDepth16u
+    toDouble = fromIntegral
+    fromDouble = round
+instance HasDepth Float where 
+    depth _ = iplDepth32f
+    toDouble = realToFrac
+    fromDouble = realToFrac
+instance HasDepth Double where 
+    depth _ = iplDepth64f
+    toDouble = id
+    fromDouble = id
+
+class ByteOrFloat a where
+instance ByteOrFloat Word8 where
+instance ByteOrFloat Float where
 
 bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
index 9674be4..100b4c6 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -7,7 +7,8 @@ module AI.CV.OpenCV.HIplUtils (isColor, isMono, imgChannels, pixels, pixelsCopy,
                                withDuplicateImage, withCompatibleImage, 
                                HIplImage, mkHIplImage, width, height, 
                                withHIplImage, FreshImage, MonoChromatic, 
-                               TriChromatic, HasChannels, HasDepth) where
+                               TriChromatic, HasChannels, HasDepth(..), 
+                               ByteOrFloat) where
 import AI.CV.OpenCV.CxCore (IplImage)
 import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.HIplImage
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
new file mode 100644
index 0000000..214a441
--- /dev/null
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
+-- |Image thresholding operations. These operations will perform
+-- destructive, in-place updates when composed with a producer of
+-- fresh images.
+module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdTruncate, 
+                               thresholdToZero, thresholdBinaryOtsu, 
+                               thresholdTruncateOtsu, thresholdToZeroOtsu) where
+import Control.Arrow (second)
+import Data.Bits ((.|.))
+import Data.Word (Word8)
+import Foreign.C.Types (CDouble, CInt)
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Storable (Storable)
+import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.CxCore 
+import AI.CV.OpenCV.HIplUtils
+
+data ThresholdType = ThreshBinary
+                   | ThreshBinaryInv
+                   | ThreshTrunc
+                   | ThreshToZero
+                   | ThreshToZeroInv
+                     deriving Enum
+
+foreign import ccall unsafe "opencv/cv.h cvThreshold"
+  c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
+                   IO (CDouble)
+
+-- The worker function that calls c_cvThreshold.
+cvThreshold :: (ByteOrFloat d, HasDepth d, Storable d) =>
+               d -> d -> Int -> HIplImage a MonoChromatic d ->
+               (HIplImage FreshImage MonoChromatic d, d)
+cvThreshold threshold maxValue tType src = 
+    unsafePerformIO $
+    withHIplImage src $ \srcPtr ->
+      cvtResult . withCompatibleImage src $ \dstPtr -> 
+                    c_cvThreshold (castPtr srcPtr) (castPtr dstPtr) 
+                                  threshold' maxValue' tType'
+    where threshold' = realToFrac . toDouble $ threshold
+          maxValue' = realToFrac . toDouble $ maxValue
+          tType' = fromIntegral tType
+          cvtResult = return . second (fromDouble . realToFrac)
+
+cvThreshold1 :: (ByteOrFloat d, HasDepth d, Storable d) =>
+               d -> d -> Int -> HIplImage a MonoChromatic d ->
+               HIplImage FreshImage MonoChromatic d
+cvThreshold1 threshold maxValue tType src = 
+    fst $ cvThreshold threshold maxValue tType src
+
+unsafeCvThreshold :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                      d -> d -> Int -> HIplImage FreshImage MonoChromatic d ->
+                      (HIplImage FreshImage MonoChromatic d, d)
+unsafeCvThreshold threshold maxValue tType src = 
+    unsafePerformIO $
+    withHIplImage src $ \srcPtr ->
+      do r <- c_cvThreshold (castPtr srcPtr) (castPtr srcPtr) 
+                             threshold' maxValue' tType'
+         return (src, fromDouble (realToFrac r))
+    where threshold' = realToFrac . toDouble $ threshold
+          maxValue' = realToFrac . toDouble $ maxValue
+          tType' = fromIntegral tType
+
+unsafeCvThreshold1 :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                      d -> d -> Int -> HIplImage FreshImage MonoChromatic d ->
+                      HIplImage FreshImage MonoChromatic d
+unsafeCvThreshold1 th mv tt = fst . unsafeCvThreshold th mv tt
+
+-- Use Otsu's method to determine an optimal threshold value which is
+-- returned along with the thresholded image.
+cvThresholdOtsu :: Word8 -> Int -> HIplImage a MonoChromatic Word8 ->
+                   (HIplImage FreshImage MonoChromatic Word8, Word8)
+cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
+    where otsu = 8
+          tType' = tType .|. otsu
+
+unsafeCvThresholdOtsu :: Word8 -> Int -> 
+                         HIplImage FreshImage MonoChromatic Word8 ->
+                         (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
+    where otsu = 8
+          tType' = tType .|. otsu
+
+-- |Binary thresholding. Each pixel is mapped to zero or
+-- @maxValue@. If @inverse@ is 'False', then pixels whose value is
+-- greater than @threshold@ are mapped to @maxValue@; if @inverse@ is
+-- 'True', then pixels whose value is less than or equal to
+-- @threshold@ are mapped to @maxValue@.  Takes the source
+-- 'HIplImage', the @threshold@ value, the @maxValue@ passing pixels
+-- are mapped to, and the @inverse@ flag.
+thresholdBinary :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                   d -> d -> Bool -> HIplImage a MonoChromatic d ->
+                   HIplImage FreshImage MonoChromatic d
+thresholdBinary th maxValue inverse = cvThreshold1 th maxValue tType
+    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+
+unsafeThreshBin :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                   d -> d -> Bool -> HIplImage FreshImage MonoChromatic d ->
+                   HIplImage FreshImage MonoChromatic d
+unsafeThreshBin th maxValue inverse = unsafeCvThreshold1 th maxValue tType
+    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+
+{-# RULES "thresholdBinary-inplace"
+  forall th mv f (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdBinary th mv f . g = unsafeThreshBin th mv f . g
+  #-}
+
+-- |Maps pixels that are greater than @threshold@ to the @threshold@
+-- value; leaves all other pixels unchanged. Takes the source
+-- 'HIplImage' and the @threshold@ value.
+thresholdTruncate :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                     d -> HIplImage a MonoChromatic d ->
+                     HIplImage FreshImage MonoChromatic d
+thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
+
+unsafeThreshTrunc :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                     d -> HIplImage FreshImage MonoChromatic d ->
+                     HIplImage FreshImage MonoChromatic d
+unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
+
+{-# RULES "thresholdTruncate-inplace"
+  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdTruncate th . g = unsafeThreshTrunc th . g
+  #-}
+
+-- |Maps pixels that are less than or equal to @threshold@ to zero;
+-- leaves all other pixels unchaged. If @inverse@ is 'True', the
+-- operation's meaning is reversed. Takes the source 'HIplImage', the
+-- @threshold@ value, and the @inverse@ flag.
+thresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                   d -> Bool -> HIplImage a MonoChromatic d ->
+                   HIplImage FreshImage MonoChromatic d
+thresholdToZero threshold inverse = cvThreshold1 threshold 0 tType
+    where tType = fromEnum $ if inverse then ThreshToZeroInv else ThreshToZero
+
+unsafeThresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                         d -> Bool -> HIplImage FreshImage MonoChromatic d ->
+                         HIplImage FreshImage MonoChromatic d
+unsafeThresholdToZero th inv = unsafeCvThreshold1 th 0 tType
+    where tType = fromEnum $ if inv then ThreshToZeroInv else ThreshToZero
+
+{-# RULES "thresholdToZero-inplace" 
+  forall th f (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdToZero th f . g = unsafeThresholdToZero th f . g
+  #-}
+
+-- |Binary thresholding using Otsu's method to determine an optimal
+-- threshold value. The chosen value is returned along with the
+-- thresholded image. Takes the source 'HIplImage' and the @maxValue@
+-- to replace pixels that pass the threshold with.
+thresholdBinaryOtsu :: Word8 -> Bool -> HIplImage a MonoChromatic Word8 ->
+                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdBinaryOtsu maxValue inverse = cvThresholdOtsu maxValue tType
+    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+
+unsafeBinOtsu :: Word8 -> Bool -> HIplImage FreshImage MonoChromatic Word8 ->
+                 (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeBinOtsu maxValue f = unsafeCvThresholdOtsu maxValue tType
+    where tType = fromEnum $ if f then ThreshBinaryInv else ThreshBinary
+
+{-# RULES "thresholdBinaryOtsu-inplace"
+  forall mv f (g::a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdBinaryOtsu mv f . g = unsafeBinOtsu mv f . g
+  #-}
+
+-- |Maps pixels that are greater than @threshold@ to the @threshold@
+-- value; leaves all other pixels unchanged. Takes the source
+-- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
+-- and returned along with the thresholded image.
+thresholdTruncateOtsu :: HIplImage a MonoChromatic Word8 -> 
+                         (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
+
+unsafeTruncOtsu :: HIplImage FreshImage MonoChromatic Word8 -> 
+                   (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
+
+{-# RULES "thresholdTruncateOtsu-inplace"
+  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdTruncateOtsu . g = unsafeTruncOtsu . g
+  #-}
+
+-- |Maps pixels that are less than or equal to @threshold@ to zero;
+-- leaves all other pixels unchaged. If @inverse@ is 'True', the
+-- operation's meaning is reversed. Takes the source 'HIplImage' and
+-- the @inverse@ flag; the @threshold@ value is chosen using Otsu's
+-- method and returned along with the thresholded image.
+thresholdToZeroOtsu :: Bool -> HIplImage a MonoChromatic Word8 -> 
+                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdToZeroOtsu inverse = cvThresholdOtsu 0 tType
+    where tType = fromEnum $ if inverse then ThreshToZeroInv else ThreshToZero
+
+unsafeToZeroOtsu :: Bool -> HIplImage FreshImage MonoChromatic Word8 -> 
+                    (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeToZeroOtsu f = unsafeCvThresholdOtsu 0 tType
+    where tType = fromEnum $ if f then ThreshToZeroInv else ThreshToZero
+
+{-# RULES "thresholdToZeroOtsu-inplace"
+  forall f (g :: a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdToZeroOtsu f . g = unsafeToZeroOtsu f . g
+  #-}
\ No newline at end of file

From 4a3167124c25632fe774eb835744f2288784d5ca Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 16 Aug 2010 20:19:34 -0400
Subject: [PATCH 032/137] Added an unsafeCanny destructive update rewrite rule.

---
 src/AI/CV/OpenCV/HIplUtils.hs |  2 +-
 src/AI/CV/OpenCV/HighCV.hs    | 14 ++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
index 100b4c6..310eb8c 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -119,7 +119,7 @@ duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
           stride = widthStep img
 
 -- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
--- of 8-bit pixel values. The new 'HIplImage' \'s pixel data is
+-- of pixel values. The new 'HIplImage' \'s pixel data is
 -- shared with the supplied 'V.Vector'.
 fromPixels :: forall a c d. 
               (HasChannels c, Integral a, HasDepth d, Storable d) =>
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 06ee742..ef3655c 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -187,6 +187,20 @@ cannyEdges threshold1 threshold2 aperture img =
         withHIplImage img $ \src -> 
             cvCanny src dst threshold1 threshold2 aperture
 
+unsafeCanny :: (HasDepth d, Storable d) =>
+               Double -> Double -> Int -> HIplImage FreshImage MonoChromatic d -> 
+               HIplImage FreshImage MonoChromatic d
+unsafeCanny threshold1 threshold2 aperture img = 
+    runST $ unsafeIOToST $
+    withHIplImage img $ \src -> 
+        cvCanny src src threshold1 threshold2 aperture >> return img
+
+{-# RULES
+    "canny-in-place" 
+    forall t1 t2 a (g::a->HIplImage FreshImage MonoChromatic d).
+    cannyEdges t1 t2 a . g = unsafeCanny t1 t2 a . g
+  #-}
+
 -- |Find the 'CvContour's in an image.
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $

From d17dee4ab279c573e60ce79d549632349cd3eafb Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 17 Aug 2010 17:22:12 -0400
Subject: [PATCH 033/137] Generalized the cvQueryFrame error message.

---
 src/AI/CV/OpenCV/HighGui.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index d50f9e7..75de388 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -79,7 +79,8 @@ foreign import ccall unsafe "highgui.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
 
 cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
-cvQueryFrame cap = errorName "Failed to query frame from camera" . checkPtr $ c_cvQueryFrame cap
+cvQueryFrame cap = errorName "Failed to query frame from capture device" . 
+                   checkPtr $ c_cvQueryFrame cap
 
 -------------------------------------------------
 -- Windows

From ff81dd3cfa0bbb87183d2ba29c584ed9d5d1e5e3 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 17 Aug 2010 17:27:51 -0400
Subject: [PATCH 034/137] Cleaned up some syntax in HighGui.

---
 src/AI/CV/OpenCV/HighGui.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index 75de388..fd7e3e9 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -52,28 +52,29 @@ foreign import ccall unsafe "highgui.h cvCreateCameraCapture"
   c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
                           
 cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
-cvCreateCameraCapture x = errorName "Failed to create camera" . checkPtr $ c_cvCreateCameraCapture . fromIntegral $ x
+cvCreateCameraCapture = errorName "Failed to create camera" . checkPtr . 
+                        c_cvCreateCameraCapture . fromIntegral
   
 foreign import ccall unsafe "highgui.h cvCreateFileCapture"
   c_cvCreateFileCapture :: CString -> IO (Ptr CvCapture)
                           
 cvCreateFileCapture :: String -> IO (Ptr CvCapture)
-cvCreateFileCapture filename = err' . checkPtr $ withCString filename f
+cvCreateFileCapture filename = err' . checkPtr $ 
+                               withCString filename c_cvCreateFileCapture
     where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'"
-          f filenameC = c_cvCreateFileCapture filenameC
   
 
 foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
   release_capture  :: Ptr CvCapture -> IO ()
 
 foreign import ccall unsafe "HOpenCV_wrap.h &release_capture"
-  cp_release_capture  :: FunPtr (Ptr CvCapture -> IO () )
+  cp_release_capture  :: FunPtr (Ptr CvCapture -> IO ())
  
 createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture)
-createCameraCaptureF = (createForeignPtr cp_release_capture) . cvCreateCameraCapture
+createCameraCaptureF = createForeignPtr cp_release_capture . cvCreateCameraCapture
 
 createFileCaptureF :: String -> IO (ForeignPtr CvCapture)
-createFileCaptureF = (createForeignPtr cp_release_capture) . cvCreateFileCapture
+createFileCaptureF = createForeignPtr cp_release_capture . cvCreateFileCapture
 
 foreign import ccall unsafe "highgui.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)

From 0ca84581e9671983609695da177ff71305e635aa Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 17 Aug 2010 20:43:03 -0400
Subject: [PATCH 035/137] Explicitly made video file playback loop.

---
 src/AI/CV/OpenCV/HighCV.hs  |  4 ++--
 src/AI/CV/OpenCV/HighGui.hs | 13 ++++++++++++-
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index ef3655c..c45c77b 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -15,7 +15,7 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HighColorConv
-import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame)
+import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame2)
 import AI.CV.OpenCV.HIplUtils
 import AI.CV.OpenCV.Contours
 import Control.Monad.ST (runST, unsafeIOToST)
@@ -212,7 +212,7 @@ createFileCapture :: (HasChannels c, HasDepth d, Storable d) =>
                      FilePath -> IO (IO (HIplImage () c d))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ 
-                                     (>>= fromPtr) . cvQueryFrame)
+                                     (>>= fromPtr) . cvQueryFrame2)
 
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs
index fd7e3e9..ecccd74 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hs
@@ -62,8 +62,19 @@ cvCreateFileCapture :: String -> IO (Ptr CvCapture)
 cvCreateFileCapture filename = err' . checkPtr $ 
                                withCString filename c_cvCreateFileCapture
     where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'"
-  
 
+foreign import ccall unsafe "highgui.h cvSetCaptureProperty"
+  c_cvSetCaptureProperty :: Ptr CvCapture -> CInt -> CDouble -> IO ()
+
+resetCapturePos :: Ptr CvCapture -> IO ()
+resetCapturePos cap = c_cvSetCaptureProperty cap 0 0
+
+cvQueryFrame2 :: Ptr CvCapture -> IO (Ptr IplImage)
+cvQueryFrame2 cap = do frame <- c_cvQueryFrame cap
+                       if frame == nullPtr
+                          then resetCapturePos cap >> cvQueryFrame cap
+                          else return frame
+  
 foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
   release_capture  :: Ptr CvCapture -> IO ()
 

From 6effe8091f5c8b41245b43f62f94374a549062ae Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 19 Aug 2010 09:59:44 -0400
Subject: [PATCH 036/137] Added Gaussian smoothing.

---
 HOpenCV.cabal                  |  1 +
 src/AI/CV/OpenCV/Filtering.hsc | 59 ++++++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/Filtering.hsc

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index fe96cde..b1a987c 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -37,6 +37,7 @@ library
       AI.CV.OpenCV.Contours
       AI.CV.OpenCV.Threshold
       AI.CV.OpenCV.ArrayOps
+      AI.CV.OpenCV.Filtering
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
new file mode 100644
index 0000000..c03edb2
--- /dev/null
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -0,0 +1,59 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- |Image filtering operations.
+module AI.CV.OpenCV.Filtering (smoothGaussian) where
+import Foreign.C.Types (CInt, CDouble)
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Storable (Storable)
+import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.HIplUtils
+
+#include <opencv/cv.h>
+
+foreign import ccall unsafe "opencv/cv.h cvSmooth"
+  c_cvSmooth :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> CDouble -> 
+                CDouble -> IO ()
+
+smooth :: Ptr IplImage -> Ptr IplImage -> CInt -> Int -> Int -> Double -> 
+          Double -> IO ()
+smooth src dst smoothType param1 param2 param3 param4 = 
+    c_cvSmooth (castPtr src) (castPtr dst) smoothType (fi param1)
+               (fi param2) (rf param3) (rf param4)
+    where fi = fromIntegral
+          rf = realToFrac
+
+cvGaussian :: CInt
+cvGaussian = #{const CV_GAUSSIAN}
+
+-- |Smooth a source 'HIplImage' using a linear convolution with a
+-- Gaussian kernel. Parameters are the kernel width, the kernel height
+-- (if 'Nothing', the height will be set to the same value as the
+-- width), the Gaussian standard deviation (if 'Nothing', it will be
+-- calculated from the kernel size), and the source image.
+smoothGaussian :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+                  Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
+                  HIplImage FreshImage c d
+smoothGaussian w h sigma src = 
+    unsafePerformIO $
+    withHIplImage src $ \src' ->
+      return . fst . withCompatibleImage src $ \dst ->
+        smooth src' dst cvGaussian w h' sigma' 0
+    where sigma' = case sigma of { Nothing -> 0; Just s -> s }
+          h' = case h of { Nothing -> 0; Just jh -> jh }
+
+unsafeGaussian  :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+                   Int -> Maybe Int -> Maybe Double ->
+                   HIplImage FreshImage c d -> HIplImage FreshImage c d
+unsafeGaussian w h sigma src = unsafePerformIO $ 
+                               withHIplImage src $ \src' ->
+                                 do smooth src' src' cvGaussian w h' sigma' 0
+                                    return src
+    where sigma' = case sigma of
+                     Nothing -> 0
+                     Just s -> realToFrac s
+          h' = case h of { Nothing -> 0; Just jh -> jh }
+
+{-# RULES "smoothGaussian/in-place"
+    forall w h sigma (g::a->HIplImage FreshImage c d). 
+    smoothGaussian w h sigma . g = unsafeGaussian w h sigma . g 
+  #-}
\ No newline at end of file

From 39639f1f5f521eb698135da79c84a70d03c7afe7 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 19 Aug 2010 21:35:24 -0400
Subject: [PATCH 037/137] Added convertScale. Improved smoothGaussian
 usability.

convertScale can be used to apply affine transformations to images
while simultaneously converting the pixel type.

smoothGaussian now has a simple version (smoothGaussian) that takes
a single parameter (kernel dimension), and a more complicated one
(smoothGaussian') that takes every parameter explicitly.
---
 HOpenCV.cabal                  |  1 +
 src/AI/CV/OpenCV/ArrayOps.hs   | 28 +++++++++++++++++++++++++--
 src/AI/CV/OpenCV/Filtering.hsc | 35 +++++++++++++++++++++++++---------
 3 files changed, 53 insertions(+), 11 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index b1a987c..c5eb8b4 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -38,6 +38,7 @@ library
       AI.CV.OpenCV.Threshold
       AI.CV.OpenCV.ArrayOps
       AI.CV.OpenCV.Filtering
+      AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/HOpenCV_wrap.c
    hs-Source-Dirs: src
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 6df9529..28912b2 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
-module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff) where
+module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff, convertScale) where
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (Storable)
@@ -94,4 +94,28 @@ unsafeAbsDiff src1 src2 = unsafePerformIO $
 {-# RULES "absDiff-inplace"
   forall m1 (g::a -> HIplImage FreshImage c d). 
   absDiff m1 . g = unsafeAbsDiff m1 . g
-  #-}
\ No newline at end of file
+  #-}
+
+foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
+  c_cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
+
+-- |Converts one array to another with optional affine
+-- transformation. Each element of the source array is multiplied by
+-- the @scale@ factor and added to the @shift@ value before being
+-- converted to the destination type with rounding and saturation. All
+-- the channels of multi-channel arrays are processed
+-- independentally. Parameters are @scale@, @shift@, and the source
+-- 'HIplImage'.
+convertScale :: (HasChannels c, HasDepth d1, HasDepth d2, 
+                 Storable d1, Storable d2) =>
+                Double -> Double -> HIplImage a c d1 -> 
+                HIplImage FreshImage c d2
+convertScale scale shift src = unsafePerformIO $
+                               do dst <- mkHIplImage (width src) (height src)
+                                  withHIplImage src $ \src' ->
+                                    withHIplImage dst $ \dst' ->
+                                      c_cvConvertScale (castPtr src') 
+                                                       (castPtr dst') 
+                                                       (realToFrac scale) 
+                                                       (realToFrac shift)
+                                  return dst
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index c03edb2..bd89b4b 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 -- |Image filtering operations.
-module AI.CV.OpenCV.Filtering (smoothGaussian) where
+module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian') where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable)
@@ -25,15 +25,27 @@ smooth src dst smoothType param1 param2 param3 param4 =
 cvGaussian :: CInt
 cvGaussian = #{const CV_GAUSSIAN}
 
+-- |Smooth a source image using a linear convolution with a Gaussian
+-- kernel. Parameters are the kernel width and the source
+-- 'HIplImage'. The kernel height will be set to the same value as the
+-- width, and the Gaussian standard deviation will be calculated from
+-- the kernel size. This function is the same as calling
+-- @smoothGaussian' width Nothing Nothing@. This operation may be
+-- performed in-place under composition.
+smoothGaussian :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+                  Int -> HIplImage a c d -> HIplImage FreshImage c d
+smoothGaussian w = smoothGaussian' w Nothing Nothing
+
 -- |Smooth a source 'HIplImage' using a linear convolution with a
 -- Gaussian kernel. Parameters are the kernel width, the kernel height
 -- (if 'Nothing', the height will be set to the same value as the
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
--- calculated from the kernel size), and the source image.
-smoothGaussian :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
-                  Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
-                  HIplImage FreshImage c d
-smoothGaussian w h sigma src = 
+-- calculated from the kernel size), and the source image. This
+-- operation may be performed in-place under composition.
+smoothGaussian' :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+                   Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
+                   HIplImage FreshImage c d
+smoothGaussian' w h sigma src = 
     unsafePerformIO $
     withHIplImage src $ \src' ->
       return . fst . withCompatibleImage src $ \dst ->
@@ -53,7 +65,12 @@ unsafeGaussian w h sigma src = unsafePerformIO $
                      Just s -> realToFrac s
           h' = case h of { Nothing -> 0; Just jh -> jh }
 
-{-# RULES "smoothGaussian/in-place"
+{-# RULES "smoothGaussian'/in-place"
     forall w h sigma (g::a->HIplImage FreshImage c d). 
-    smoothGaussian w h sigma . g = unsafeGaussian w h sigma . g 
-  #-}
\ No newline at end of file
+    smoothGaussian' w h sigma . g = unsafeGaussian w h sigma . g 
+  #-}
+
+{-# RULES "smoothGaussian/in-place"
+    forall w (g::a->HIplImage FreshImage c d).
+    smoothGaussian w . g = unsafeGaussian w Nothing Nothing . g
+  #-}

From 28e5b53966fcfb1b9c94e6b7ad1efc25cb639f1c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 19 Aug 2010 21:37:04 -0400
Subject: [PATCH 038/137] Added Harris corner detector.

---
 src/AI/CV/OpenCV/FeatureDetection.hs | 48 ++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/FeatureDetection.hs

diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
new file mode 100644
index 0000000..a5bcae4
--- /dev/null
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- |Feature Detection.
+module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris') where
+import Foreign.C.Types (CInt, CDouble)
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Storable (Storable)
+import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.HIplUtils
+
+foreign import ccall unsafe "opencv/cv.h cvCornerHarris"
+  c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
+
+harris :: Ptr IplImage -> Ptr IplImage -> Int -> Int -> Double -> IO ()
+harris src dst blockSize aperture k = 
+    c_cvHarris (castPtr src) (castPtr dst) (fi blockSize) (fi aperture) (rf k)
+    where fi = fromIntegral
+          rf = realToFrac
+
+-- |Harris corner detector. For each pixel, a 2x2 covariance matrix,
+-- @M@, is computed over a @blockSize x blockSize@ neighborhood. The
+-- value of @det(M) - 0.04*trace(M)^2@ is stored in the destination
+-- image. Corners in the image correspond to local maxima of the
+-- destination image. The parameters are the @blockSize@ and the
+-- source 'HIplImage'. The Sobel operator used as a preprocessing step
+-- is given an aperture size of 3.
+cornerHarris :: (ByteOrFloat d, HasDepth d, Storable d) => 
+                Int -> HIplImage a MonoChromatic d -> 
+                HIplImage FreshImage MonoChromatic Float
+cornerHarris blockSize = cornerHarris' blockSize 3 0.04
+
+-- |Harris corner detector. For each pixel, a 2x2 covariance matrix,
+-- @M@, is computed over a @blockSize x blockSize@ neighborhood. The
+-- value of @det(M) - k*trace(M)^2@ is stored in the destination
+-- image. Corners in the image correspond to local maxima of the
+-- destination image. The parameters are the @blockSize@, the
+-- @aperture@ size to be used by the Sobel operator that is run during
+-- corner evaluation, the value of @k@, and the source
+-- 'HIplImage'.
+cornerHarris' :: (ByteOrFloat d, HasDepth d, Storable d) => 
+                 Int -> Int -> Double -> HIplImage a MonoChromatic d -> 
+                 HIplImage FreshImage MonoChromatic Float
+cornerHarris' blockSize aperture k src = 
+    unsafePerformIO $ do dst <- mkHIplImage (width src) (height src)
+                         withHIplImage src $ \src' ->
+                           withHIplImage dst $ \dst' ->
+                             harris src' dst' blockSize aperture k
+                         return dst

From 4ff84c25ec2caf568ff24221732c3900c9a81399 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 20 Aug 2010 18:17:48 -0400
Subject: [PATCH 039/137] Added cvAnd. This is still under development.

---
 src/AI/CV/OpenCV/ArrayOps.hs | 64 ++++++++++++++++++++++++++++++++++--
 1 file changed, 62 insertions(+), 2 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 28912b2..1253add 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,10 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
-module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff, convertScale) where
+-- |Array operations.
+module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff, convertScale, 
+                              cvAnd, cvAndMask) where
+import Data.Word (Word8)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.CxCore (CvArr)
+import AI.CV.OpenCV.CxCore (CvArr, IplImage)
 import AI.CV.OpenCV.HIplUtils
 
 foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
@@ -119,3 +122,60 @@ convertScale scale shift src = unsafePerformIO $
                                                        (realToFrac scale) 
                                                        (realToFrac shift)
                                   return dst
+
+foreign import ccall unsafe "opencv/cxcore.h cvAnd"
+  c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+cvAndAux :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> IO ()
+cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
+                                      (castPtr dst) (castPtr mask)
+
+-- |Calculate the per-element bitwise conjunction of two arrays. The
+-- mask specifies the elements of the result that will be computed via
+-- the conjunction, and those that will simply be copied from the
+-- third parameter 'HIplImage' (i.e. the second source array)
+cvAndMask :: (HasChannels c, HasDepth d, Storable d) => 
+             HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
+             HIplImage b c d -> HIplImage FreshImage c d
+cvAndMask mask src1 src2 = unsafePerformIO $
+                        withHIplImage src1 $ \src1' ->
+                          withHIplImage src2 $ \src2' ->
+                            return . fst. withDuplicateImage src2 $ \dst ->
+                              withHIplImage mask $ \mask' ->
+                                cvAndAux src1' src2' dst mask'
+
+-- |Calculates the per-element bitwise conjunction of two arrays.
+cvAnd :: (HasChannels c, HasDepth d, Storable d) => 
+          HIplImage a c d -> HIplImage b c d ->  HIplImage FreshImage c d
+cvAnd src1 src2 = unsafePerformIO $
+                  withHIplImage src1 $ \src1' ->
+                    withHIplImage src2 $ \src2' ->
+                      return . fst . withCompatibleImage src1 $ \dst ->
+                        cvAndAux src1' src2' dst nullPtr
+                                
+
+unsafeAnd :: (HasChannels c, HasDepth d, Storable d) => 
+             HIplImage a c d -> HIplImage FreshImage c d ->  
+             HIplImage FreshImage c d
+unsafeAnd src1 src2 = unsafePerformIO $
+                      withHIplImage src1 $ \src1' ->
+                        withHIplImage src2 $ \src2' ->
+                          cvAndAux src1' src2' src2' nullPtr >> return src2
+
+unsafeAndMask :: (HasChannels c, HasDepth d, Storable d) => 
+                 HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
+                 HIplImage FreshImage c d -> HIplImage FreshImage c d
+unsafeAndMask mask src1 src2 = unsafePerformIO $
+                      withHIplImage src1 $ \src1' ->
+                        withHIplImage src2 $ \src2' ->
+                          withHIplImage mask $ \mask' ->
+                            cvAndAux src1' src2' src2' mask' >> return src2
+
+{-# RULES "cvAnd/in-place"
+    forall s (g :: a -> HIplImage FreshImage c d). cvAnd s . g = unsafeAnd s . g
+  #-}
+
+{-# RULES "cvAndMask/in-place"
+    forall m s (g :: a -> HIplImage FreshImage c d).
+    cvAndMask m s . g = unsafeAndMask m s . g 
+  #-}
\ No newline at end of file

From 5ae025ca72fa17de6a41961906670ee138eab2e2 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 23 Aug 2010 21:29:40 -0400
Subject: [PATCH 040/137] Prevent unsafe inlining. Changed queryFrame interface
 to return a Maybe.

Improved the CvCapture interface to allow random seeking.
---
 src/AI/CV/OpenCV/ArrayOps.hs                 | 19 +++---
 src/AI/CV/OpenCV/CxCore.hsc                  |  5 ++
 src/AI/CV/OpenCV/HIplUtils.hs                | 65 ++++++++++----------
 src/AI/CV/OpenCV/HighCV.hs                   | 31 +++++++---
 src/AI/CV/OpenCV/{HighGui.hs => HighGui.hsc} | 41 ++++++++----
 src/Test.hs                                  |  6 +-
 6 files changed, 102 insertions(+), 65 deletions(-)
 rename src/AI/CV/OpenCV/{HighGui.hs => HighGui.hsc} (70%)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 1253add..1f39158 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -137,22 +137,19 @@ cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
 cvAndMask :: (HasChannels c, HasDepth d, Storable d) => 
              HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
              HIplImage b c d -> HIplImage FreshImage c d
-cvAndMask mask src1 src2 = unsafePerformIO $
-                        withHIplImage src1 $ \src1' ->
-                          withHIplImage src2 $ \src2' ->
-                            return . fst. withDuplicateImage src2 $ \dst ->
-                              withHIplImage mask $ \mask' ->
-                                cvAndAux src1' src2' dst mask'
+cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
+                             withHIplImage src1 $ \src1' ->
+                               withHIplImage src2 $ \src2' ->
+                                 withHIplImage mask $ \mask' ->
+                                   cvAndAux src1' src2' dst mask'
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d, Storable d) => 
           HIplImage a c d -> HIplImage b c d ->  HIplImage FreshImage c d
-cvAnd src1 src2 = unsafePerformIO $
-                  withHIplImage src1 $ \src1' ->
-                    withHIplImage src2 $ \src2' ->
-                      return . fst . withCompatibleImage src1 $ \dst ->
+cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
+                    withHIplImage src1 $ \src1' ->
+                      withHIplImage src2 $ \src2' ->
                         cvAndAux src1' src2' dst nullPtr
-                                
 
 unsafeAnd :: (HasChannels c, HasDepth d, Storable d) => 
              HIplImage a c d -> HIplImage FreshImage c d ->  
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc
index 054f196..98fafdb 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/CxCore.hsc
@@ -311,6 +311,11 @@ cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
         where fi = fromIntegral
               fr = realToFrac
 
+-- |Convert null pointers to 'Nothing' and non-null pointers to 'Just'
+-- values.
+ptrToMaybe :: Ptr a -> Maybe (Ptr a)
+ptrToMaybe p = if p == nullPtr then Nothing else Just p
+
 ------------------------------------------------------------------------------
 -- Debugging stuff, not part of opencv
 
diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/HIplUtils.hs
index 310eb8c..4686ddd 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/HIplUtils.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |Functions for working with 'HIplImage's.
-module AI.CV.OpenCV.HIplUtils (isColor, isMono, imgChannels, pixels, pixelsCopy,
+module AI.CV.OpenCV.HIplUtils (isColor, isMono, imgChannels, withPixels, pixels,
                                fromPtr, fromFileColor, fromFileGray, toFile, 
                                compatibleImage, duplicateImage, fromPixels, 
-                               fromPixelsCopy, fromGrayPixels, fromColorPixels, 
+                               withImagePixels, fromGrayPixels, fromColorPixels,
                                withDuplicateImage, withCompatibleImage, 
                                HIplImage, mkHIplImage, width, height, 
                                withHIplImage, FreshImage, MonoChromatic, 
@@ -38,11 +38,12 @@ isMono = id
 imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
--- |Return a 'V.Vector' containing the pixels that make up an
--- 'HIplImage'. This does not copy the underlying data!
-pixels :: forall a c d. (HasDepth d, Storable d) => 
-          HIplImage a c d -> V.Vector d
-pixels img = V.unsafeFromForeignPtr (imageData img) 0 n
+-- |Apply the supplied function to a 'V.Vector' containing the pixels
+-- that make up an 'HIplImage'. This does not copy the underlying
+-- data.
+withPixels :: forall a c d r. (HasDepth d, Storable d) => 
+              HIplImage a c d -> (V.Vector d -> r) -> r
+withPixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
     where n = imageSize img `div` bytesPerPixel (undefined::d)
 
 doST :: IO a -> a
@@ -51,12 +52,12 @@ doST x = runST (unsafeIOToST x)
 -- |Return a 'V.Vector' containing the pixels that make up an
 -- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
 -- pixel data.
-pixelsCopy :: Storable d => HIplImage a c d -> V.Vector d
-pixelsCopy img = doST $ do ptr <- mallocForeignPtrBytes len
-                           withForeignPtr ptr $
-                              \dst -> withForeignPtr (imageData img) $
-                                        \src -> copyBytes dst src len
-                           return $ V.unsafeFromForeignPtr ptr 0 len
+pixels :: Storable d => HIplImage a c d -> V.Vector d
+pixels img = doST $ do ptr <- mallocForeignPtrBytes len
+                       withForeignPtr ptr $ \dst -> 
+                         withForeignPtr (imageData img) $ \src -> 
+                             copyBytes dst src len
+                       return $ V.unsafeFromForeignPtr ptr 0 len
     where len = imageSize img
 
 -- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
@@ -118,15 +119,15 @@ duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
           sz = imageSize img
           stride = widthStep img
 
--- |Construct an 'HIplImage' from a width, a height, and a 'V.Vector'
--- of pixel values. The new 'HIplImage' \'s pixel data is
--- shared with the supplied 'V.Vector'.
-fromPixels :: forall a c d. 
-              (HasChannels c, Integral a, HasDepth d, Storable d) =>
-              a -> a -> V.Vector d -> HIplImage () c d
-fromPixels w h pix = if fromIntegral len == sz
-                     then HIplImage 0 w' h' sz fp (w'*nc)
-                     else error "Length disagreement"
+-- |Pass the given function a 'HIplImage' constructed from a width, a
+-- height, and a 'V.Vector' of pixel values. The new 'HIplImage' \'s
+-- pixel data is shared with the supplied 'V.Vector'.
+withImagePixels :: forall a c d r. 
+                   (HasChannels c, Integral a, HasDepth d, Storable d) =>
+                   a -> a -> V.Vector d -> (HIplImage () c d -> r) -> r
+withImagePixels w h pix f = if fromIntegral len == sz
+                            then f $ HIplImage 0 w' h' sz fp (w'*nc)
+                            else error "Length disagreement"
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -134,15 +135,15 @@ fromPixels w h pix = if fromIntegral len == sz
           (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
                          (fp,0,len) -> (fp,len)
                          _ -> error "fromPixels non-zero offset"
-{-# INLINE fromPixels #-}
+{-# INLINE [0] withImagePixels #-}
 
 -- |Construct a fresh 'HIplImage' from a width, a height, and a
 -- 'V.Vector' of 8-bit pixel values.
-fromPixelsCopy :: forall a c d. 
-                  (Integral a, HasChannels c, HasDepth d, Storable d) =>
-                  a -> a -> V.Vector d -> HIplImage FreshImage c d
-fromPixelsCopy w h pix = doST $ do fp <- copyData
-                                   return $ HIplImage 0 w' h' sz fp (w'*nc)
+fromPixels :: forall a c d. 
+              (Integral a, HasChannels c, HasDepth d, Storable d) =>
+              a -> a -> V.Vector d -> HIplImage FreshImage c d
+fromPixels w h pix = doST $ do fp <- copyData
+                               return $ HIplImage 0 w' h' sz fp (w'*nc)
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -154,18 +155,18 @@ fromPixelsCopy w h pix = doST $ do fp <- copyData
                                        \dst -> let src' = plusPtr src offset
                                                in copyBytes dst src' len
                            return fp
-{-# INLINE fromPixelsCopy #-}
+{-# INLINE [0] fromPixels #-}
 
 -- |Helper function to explicitly type a vector of monochromatic pixel
 -- data.
 fromGrayPixels :: Integral a => 
-                  a -> a -> V.Vector Word8 -> HIplImage () MonoChromatic Word8
+                  a -> a -> V.Vector Word8 -> HIplImage FreshImage MonoChromatic Word8
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of trichromatic pixel
 -- data.
 fromColorPixels :: Integral a =>
-                   a -> a -> V.Vector Word8 -> HIplImage () TriChromatic Word8
+                   a -> a -> V.Vector Word8 -> HIplImage FreshImage TriChromatic Word8
 fromColorPixels w h = isColor . fromPixels w h
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
@@ -179,6 +180,7 @@ withDuplicateImage img1 f = runST $ unsafeIOToST $
                             do img2 <- duplicateImage img1
                                r <- withHIplImage img2 f
                                return (img2, r)
+{-# NOINLINE withDuplicateImage #-}
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
@@ -190,3 +192,4 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
                                 return (img2, r)
+{-# NOINLINE withCompatibleImage #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index c45c77b..4d10c4a 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -4,18 +4,20 @@
 -- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
                             LineType(..), RGB, drawLines, HIplImage, width, 
-                            height, pixels, fromGrayPixels, fromColorPixels, 
-                            fromFileGray, fromFileColor, toFile, findContours, 
-                            fromPtr, isColor, isMono, fromPixels, sampleLine,
-                            Connectivity(..), fromPixelsCopy, cannyEdges,
-                            createFileCapture, resize, InterpolationMethod(..),
+                            height, pixels, withPixels, fromGrayPixels, 
+                            fromColorPixels, fromFileGray, fromFileColor, 
+                            toFile, findContours, fromPtr, isColor, isMono, 
+                            withImagePixels, sampleLine, Connectivity(..), 
+                            fromPixels, cannyEdges, createFileCapture, 
+                            resize, InterpolationMethod(..),
                             MonoChromatic, TriChromatic, FreshImage,
                             module AI.CV.OpenCV.HighColorConv)
     where
 import AI.CV.OpenCV.CxCore
 import AI.CV.OpenCV.CV
 import AI.CV.OpenCV.HighColorConv
-import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame2)
+import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame, setCapturePos, 
+                             CapturePos(PosFrames), CvCapture)
 import AI.CV.OpenCV.HIplUtils
 import AI.CV.OpenCV.Contours
 import Control.Monad.ST (runST, unsafeIOToST)
@@ -206,13 +208,28 @@ findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
 
+-- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
+-- returns a 'Ptr' 'IplImage'.
+queryError :: Ptr CvCapture -> IO (Ptr IplImage)
+queryError = (maybe (error "Unable to capture frame") id `fmap`) . cvQueryFrame
+
+-- |If 'cvQueryFrame' returns 'Nothing', try rewinding the video and
+-- querying again. If it still fails, raise an error. When a non-null
+-- frame is obtained, return it.
+queryFrameLoop :: Ptr CvCapture -> IO (Ptr IplImage)
+queryFrameLoop cap = do f <- cvQueryFrame cap
+                        case f of
+                          Nothing -> do setCapturePos cap (PosFrames 0)
+                                        queryError cap
+                          Just f' -> return f'
+
 -- |Open a capture stream from a movie file. The action returned may
 -- be used to query for the next available frame.
 createFileCapture :: (HasChannels c, HasDepth d, Storable d) =>
                      FilePath -> IO (IO (HIplImage () c d))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ 
-                                     (>>= fromPtr) . cvQueryFrame2)
+                                     (>>= fromPtr) . queryFrameLoop)
 
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hsc
similarity index 70%
rename from src/AI/CV/OpenCV/HighGui.hs
rename to src/AI/CV/OpenCV/HighGui.hsc
index ecccd74..ea59afa 100644
--- a/src/AI/CV/OpenCV/HighGui.hs
+++ b/src/AI/CV/OpenCV/HighGui.hsc
@@ -1,6 +1,11 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
- 
-module AI.CV.OpenCV.HighGui where
+module AI.CV.OpenCV.HighGui (cvLoadImage, LoadColor(..), cvSaveImage, 
+                             CvCapture, cvCreateCameraCapture, 
+                             createCameraCaptureF, createFileCaptureF,
+                             cvCreateFileCapture, setCapturePos, 
+                             CapturePos(..), cvQueryFrame,
+                             newWindow, delWindow, showImage, waitKey,
+                             cvConvertImage) where
  
 import Foreign.ForeignPtrWrap
 import Foreign.C.Types
@@ -10,6 +15,7 @@ import Foreign.C.String
  
 import AI.CV.OpenCV.CxCore
 
+#include <opencv/highgui.h>
 
 ------------------------------------------------
 -- General
@@ -66,14 +72,22 @@ cvCreateFileCapture filename = err' . checkPtr $
 foreign import ccall unsafe "highgui.h cvSetCaptureProperty"
   c_cvSetCaptureProperty :: Ptr CvCapture -> CInt -> CDouble -> IO ()
 
-resetCapturePos :: Ptr CvCapture -> IO ()
-resetCapturePos cap = c_cvSetCaptureProperty cap 0 0
-
-cvQueryFrame2 :: Ptr CvCapture -> IO (Ptr IplImage)
-cvQueryFrame2 cap = do frame <- c_cvQueryFrame cap
-                       if frame == nullPtr
-                          then resetCapturePos cap >> cvQueryFrame cap
-                          else return frame
+-- |The current position of a video capture.
+data CapturePos = PosMsec Double  
+                -- ^Position in milliseconds or video timestamp.
+                | PosFrames Int   
+                -- ^0-based index of the next frame to be decoded or captured.
+                | PosRatio Double 
+                -- ^Relative position of the video file (0 = start, 1 = end).
+
+posEnum :: CapturePos -> (CInt, CDouble)
+posEnum (PosMsec t) = (#{const CV_CAP_PROP_POS_MSEC}, realToFrac t)
+posEnum (PosFrames n) = (#{const CV_CAP_PROP_POS_FRAMES}, fromIntegral n)
+posEnum (PosRatio r) = (#{const CV_CAP_PROP_POS_AVI_RATIO}, realToFrac r)
+
+-- |Set the current position of a video capture.
+setCapturePos :: Ptr CvCapture -> CapturePos -> IO ()
+setCapturePos cap pos = uncurry (c_cvSetCaptureProperty cap) $ posEnum pos
   
 foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
   release_capture  :: Ptr CvCapture -> IO ()
@@ -90,9 +104,10 @@ createFileCaptureF = createForeignPtr cp_release_capture . cvCreateFileCapture
 foreign import ccall unsafe "highgui.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
 
-cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
-cvQueryFrame cap = errorName "Failed to query frame from capture device" . 
-                   checkPtr $ c_cvQueryFrame cap
+cvQueryFrame :: Ptr CvCapture -> IO (Maybe (Ptr IplImage))
+cvQueryFrame cap = ptrToMaybe `fmap` c_cvQueryFrame cap
+-- cvQueryFrame cap = errorName "Failed to query frame from capture device" . 
+--                    checkPtr $ c_cvQueryFrame cap
 
 -------------------------------------------------
 -- Windows
diff --git a/src/Test.hs b/src/Test.hs
index f348817..469769f 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,5 +1,5 @@
 module Main where
-
+import Data.Maybe (fromJust)
 import Foreign.Ptr
 import Foreign.ForeignPtr
 import Foreign.C.Types
@@ -12,7 +12,7 @@ import Control.Monad(when)
 
 showFrames :: CInt -> Ptr IplImage -> Ptr CvCapture -> IO ()
 showFrames winNum targetImage cvcapture  = do
-  frame <- cvQueryFrame cvcapture 
+  frame <- fromJust `fmap` cvQueryFrame cvcapture 
   cvConvertImage (fromArr frame) (fromArr targetImage) 0
   calcFrame targetImage
       where calcFrame targetSmall = do
@@ -25,7 +25,7 @@ showFrames winNum targetImage cvcapture  = do
   
 processImages :: Ptr CvCapture -> IO ()
 processImages capture = do
-  frame <- cvQueryFrame capture
+  frame <- fromJust `fmap` cvQueryFrame capture
   let winNum = 0
   newWindow winNum True
   target <- createImageF (cvGetSize frame) 1 iplDepth8u

From f65e6993acbbc74caaac326182da260de8974801 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 Aug 2010 12:32:39 -0400
Subject: [PATCH 041/137] Added an example of morphological closing.

---
 HOpenCV.cabal                   |  12 ----------
 src/Examples/Closing/Closing.hs |   3 +++
 src/Examples/Closing/input.png  | Bin 0 -> 9122 bytes
 src/Test.hs                     |  40 --------------------------------
 4 files changed, 3 insertions(+), 52 deletions(-)
 create mode 100644 src/Examples/Closing/Closing.hs
 create mode 100644 src/Examples/Closing/input.png
 delete mode 100644 src/Test.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index c5eb8b4..76a0e8b 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -49,15 +49,3 @@ library
                   directory >= 1.0.1.0 && < 1.1,
                   vector >= 0.6.0.2 && < 0.7
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing
-
-executable test-hopencv
-  c-sources:
-     src/AI/CV/OpenCV/HOpenCV_wrap.c
-  hs-source-dirs:  src
-  Build-Depends: base >=4 && <5
-  main-is: Test.hs
-  Ghc-Options: -Wall -fno-warn-type-defaults
-  Ghc-Prof-Options:  -prof -auto-all 
-  extra-libraries: cxcore,cv,highgui
-  other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, 
-                 AI.CV.OpenCV.Types AI.CV.OpenCV.ColorConversion
diff --git a/src/Examples/Closing/Closing.hs b/src/Examples/Closing/Closing.hs
new file mode 100644
index 0000000..cc44d56
--- /dev/null
+++ b/src/Examples/Closing/Closing.hs
@@ -0,0 +1,3 @@
+import AI.CV.OpenCV.HighCV
+
+main = toFile "closed.png" . erode 8 . dilate 8 =<< fromFileGray "input.png"
\ No newline at end of file
diff --git a/src/Examples/Closing/input.png b/src/Examples/Closing/input.png
new file mode 100644
index 0000000000000000000000000000000000000000..e942bb85a06d8a14cd3b0609b78f35a4a7450867
GIT binary patch
literal 9122
zcmdU#RZtyKv+rla#$AGI@Zbb@3+};Pg1b9xG`K@>2!!Ag+#$GIaCd?Qcf0$mQ+3X*
zI?wmvKF!pcSv9@Z>hAxqyCzaaNg55A2pIqXG+7x*H2?rXZ$SVe4D|8`Q-mD=FqEw&
zBvfQ2Bq&r|94)Nv%mKg)RH^OFn_~1N(i`J%G%&H~32!#Ze=8(_WH!K&#vbdB^iD3N
zKL7p9w|W&haoG|kRoukNiqeFkq@+8-qo)_<1>cUh_Jh`azPu~GJC|J7Jia@35x@y~
zXK2@n2oMD`WNzD8M_pcDN=;+Hf-%7)qBv~Z=c-?D=;#Dwb~ox9cmSy!pGt*>hKE0$
z(N>Pr{y`L@?eAl~Zyi%!r|fWtC;>K_h)tyR{sDE8nrMSkUY1M}wBb+{c44qI#EBy`
zmA-018&OL<o!JY2;j?o$%fI|>Z9g^*Peg#91v^Lv1`<Hl6CT=4FUYBQBTpf@MMdF<
z3=s83M92&YOSATkZVltgd^3aXQJeJ-@+rZZ2Tg@YaEHHbiT8s_S`i>M_afORRKUG6
zu&R0gRnK{SiIL#aTs<NDF^-QQngNKoI6ZwwXk}jvS{zwfe^qVl=x~PvmQ?|=uRCV+
zzXWQhqPu;7d*z)q&(}&Z6gUKAw%8Aqu!3OcgnxoB_TicXls_lOMk^HT{7$w>MzVeM
zX;(c2tJ=wAjD!V6R3S_RG`P$pRM@PU)M?>z_{!gSKX~gO{kZ1Kh^{SiNxf{sJ$kp2
z3ZFu!K0l>kgMCCq<d9B1u2#u%ie}&~l>OQ-WEO5JCAstTlWFnA!jrj~i9yq!yR4D!
zq?3P<PxH*&6W#OB1;+*B&TF@S|Fo%k<{*o8{;WAr84y@cbmBiZXZsw1#7<k!Z}&bp
z>kA&Cbf>p5FEUwd+(q<wq%VQUx1o$L=?cQyNi(_pncUu1`{&PzMb~>V4P%vN=S*ok
z*-Pzw@9B1xY<7?GIEL%^JMLnhbk1BmAMRmHO%@+&Q2L_#3Z}Lb<eRb2)V_^2nh$8r
zz9zALt4!$ppc>gq>te78f2KI`A<iaEFG8=&!Ev@?Ri|0tvw%x=b=6aVp1*{I;?6k2
z0-2%1NT6Ho!~M>6nnY!!eG1)=;vbe<r_JbgbhWOv#}ikx4q0TKxl8yBtbcrSp86i~
z421%67S4F`1#2GmAB=xv{;RxPIqRL2a*<velpOduSiY{hZrkxDJk6WIS;W)8ZNQT(
zXnPrSD{-JdA^laEB+oFACH+o+(}+Nq>3O@QuZ#1X%W=sh%)RJJ@3Cz7=ytjArVnjA
zw&+YF%S2>1aO{<7<?@Z@*4FE(`<5Fwke3;sBy#inPLZXhvBekTRny0b=P>ik8)iKW
zUleIHOTq=6f2g^<>ukFL!qNd1kgEK&gru6Xh^UgZbjlI^RT*(<H61xwU0EqHJmzBR
zc+Dxbz7I?EzGaviI8!<{{YUOZtnAUc*~<i^_-m3K<&PoosNtDX2r=af`!!J(Ci_iH
z+!bS$b@t&WvnR=<kJ+KO@B#}hJ*y{c%Dyo^!@kLPYZp3qa~A@CH)2+Lj&V$3&k!m@
zOE4uQs=xY2B~U&{;w5dUG#Ba@UYWLT6KtPiE71xoX3D+#oy(8d9NpEAOLWCi%;<15
ze}s#RB1s+*Ctn!l9{(l0<u&th;UFcDY|HI$#!%g^Ys&Kwj2h*GUtd^$^y{bGex+|?
z^7V45tc>3n3=+Ri1nGy3X_U$h+o~<lI7Y1DR$*7*HTMT*HH9CeKN;NWHu_e$SKRR(
zC!#&aK4XNE6=Z%PFXglqp0{VWcelC<s68v)`#4*-cRLYRFcHC$eBd{U-<o%u9f);-
zy}~%tHotIHcH*wz)eGtCKFXT-UGROViMBVp*NlosI(e{SfNxNGJ+%WPM<qi$vm%e5
zi<HBRbCjp;d~101A^wN*ejc1~U}j*mld1C?ek!X-+HzN};jKZUk<RO_F_-JObxxqa
zTj7a-Gfqd##m?4bJ@b{3U6-MQ^vOV;MUDs3E80bvLr_4FNsx24b!bc89-l3a9+xkY
zG`A%QKByITs{N#$aY(q6`1ue<IM|9ZbSmGeMJA@Cg`jPbpiEy-TwFOx=`wbf>kyZa
zM~8+Fz6Im*6gf4DE~Oy#t~9-@EI(|HU~YcSlJk)*p3Bkpovr0z-_iE<$@Sfd7~vEl
z6Cpam+DBnCY+JcLpLCt{W9=dBOFhbp`3jNc_J-4%^15m#dbcr`sIL>@ZP7X9omok3
z=?F8)bI}9GS$Bi}$-=!)PyW8o%g^LnnJ`2bo`_m7b;0z%11L2m=Tv^PJ=V;fA4Ukz
z6b{+AECu<E{3^Nsn?SIk{gt=ZYYu!NnM>_8BX{`}!m37Av@RpyOMl}ug*E7=0MCJw
z))L^hwWvOSezAUXn>~Qjq@=lzmoqXUFQh0e!F%j6@t*uMg~pICne*#PSVpwOC!zj$
zmNg~@79m%@LZ%0~U881~_^1x8O2(UNS$%{BX-C0!9qmu09_>XgS*N$Aijz6Eo^`fV
zXDzeV>(c8+)#Ub8HcSBtmzWEo{?uzRR=GZ_^J>$X>*2np=j!K&%XRCwmvJW(1yyMW
z$!jaDV56g3pF5ha4?b(tUFT9>Q_l2H_IHSPC2!ij0{`wxaW;OUkJpSF=D0rgJv@wy
z-+X(n_Gaua=Q^&-D#?58QY*RG826ve7A=MoH9-Y(aRA<LunBE&Mf`X`f(n_tDO|S(
zez&eG=tK%0lCdAW@c^s#1B42}iGVRT2J4IQ4uQ40aoAwZf=he-j0cTxYT`NHb2@O+
zS+`mdT2)%rSwC$CJHfQWcg8wN>WldmyB4%5VH6Kei&$V<^7gO|T1{&AQV*p}a8925
zUL7fzP#cq*B<kfK-XEIps~R#K5}U;8Xa9ZJx71fOq%jn`8Ml?Y<-BFR_30|@eM<u2
z(3#(s-`PXQy%DlDvLN0nl{VcEnpt`~`qdAnG&77x4E$75SSwO{5z$c_sWoZo2?|Nu
ziDii%Nrq_*30x^TNu!Aisd*Z_#a2I?3)H`#l=oE6lxK!<Yr)zm9+eXPB+ykTw+K(m
zX)HmHohbO1Z&?1iCbS1{iS{vOJ4QnB{O8jz77NY&pLkMf1DXT#1KeqiN*?RCLFiuw
zsg&S+ZL<XoXjhH@)so%jIvbj=hX|iM-S}MuSia~vGkWO+I~t3rC?k?ib8s?N&;^I=
zlIh63inB+K#0B6-M~+63E2=B;X9|8ZP1DW3-Klv>3`hMnmQvWOBQ<!ocb|<rK{_N5
zNV}Q+<+Zry2!-L(?YCxmT9yTaVMaRrhSr}hAqV^MNBt}0{}dMD7RKkQg^jI~>^!U@
z?d1J+m)95h))n7i){Y;J)B^`8*7QzfZWsUhW(@Bh24NtRV+7>t*6Xx3_Ouf<2zOXt
zTv6UUi^k%yfeb0&>LH|v;IG~0Q}Dt)&Boz1h}uYYknq%jDB9$GLT0K;Dtpi=SRX4F
z(NX%GN*puR&CX4-)x*d8k?C;~RSC5rrXWU|u#3a{qdS`|$G2Zjzer4U%+M@I!{2Z8
zR1F8@NF?pR&><YCP8jL`(jQ%w{D+k5FX-q+>eZHjH-sk)+vyWv|M~<&1Tz<G6WkO!
z8+!D;q$zSS3N_*}k|m0!kU%wT8+kjPW|exM=3|j$5z&veqJ{jD<I%XGqT$hzF7*g4
zNd^!4PYltFcjZ6IZAz31QD!S<8}pf@dSpz(IhC!KY^fR++-TkNj^_@I)?9y6jIvGB
zuP#pZ^}4ankBoKeufUi^{+g+suV=4msBx{m^FVY_a2i?C+gd&0_}luAW!vP4a7*Lw
z+G)sQ{O!%Tz>!gOR^Jt71<Yrt$(E5x-<xZa&YhE-evr33cblg8xQUM?^EP_jg%<Q>
ze5nk{V5pwyLk}Z&kg*)^HrFIy8><xwKp3&qYf1I)v;<Fh9FQ~23U~SZs!CUXuf?zB
z@l@T6yd(F|mfS(Gg5Q&|k#@7{RH*XF2JHg|n<D&pE^{b%a<R>6a1N7!-WoA0p07yf
z<NTXz!b9aIqQ%&b!Hne6?6J;0$^Pd>ztinUt&miS@@no~9tM%8w>XiHo3I?B_`JcG
z3FsqY0@@Ht6K!qW3K(vsUWAuB6srMibE`t@yx(D4&gY;|^n#SQNEW0KKFaH4)K}D<
zn5XY!INhAR3SSIOBh8j9#!V$^Q-77$^0=PtrEdui_4jIw+fR0MCl8j73q*}=t@QFt
zzI_vg<fm*xresYRvC@akrg7On<C4s=1jw1@{m9-eQ_phiR7hviL}$3u=+xUP+oq%;
zH<x&aq@g=U=vJ(o>Jv0TsgUq9WS-2Pi`3o#R>;i%ScnXsx0kI@dxwhlK%v_7EVCgK
zL)))0Snq1ZYPog!(^8&Ci95-X{6UQKh3mNc@ioLd)2qm*>FNAm)0N^y`JEAJ!XOUf
zyCB!!9F$vq18iQ+wteO^Jhi7m$Ri&0S_%@`qJH{4<<tr;vd9KDGP-9bV~I(qjbn?2
zR61#cdM>NV6$kr!*4bnNS(&V==huFVpS~BQ$=|E(kD_Ubk9vRL|L~{Eb}ha7L)WL0
z#I8DRJ&kWFjw|$!#w~}Ru3pkY=UeE|mB||m1*$wFg+=~I+`Zr0lgnEu$A966r3o<}
zIzBzcx-VH-EV{V3Q^OHXru#{zfH7VXu$l4s+3I<CtM00OC-|jc9KVp}rn<!Z=N>Dg
z|3;aX>wLuVPht|{oef6^+Si)b;X7Bm@_Q{}uGhAknF*op&{)*?ANeOW76QF*>s0Rr
z;md|Si14q!P{Q%@iVMA)Of1YPX`sM<w3q5{O_vZtP)BzLV=-3*n&E;hEl^BMBBbfU
zjY%m`_qfsxF#CH5dlE>~E$Jr)kb3Me(b1?|TAufJhPMQ`STy!|`Ib{YOk!*mbkkpn
za5O|xR*`kN=c$@zuTe0;4PSr#w5+yQ+R2R=WYM)C1xptuuqY;2Z$U(6TF>SFB8aI8
z-~kBq6a=lGQopz1qKpNIsA9$k4<t_6QA7mq{`A~^m1#MPiF}imCj_4^Mz2jH!PX@x
zg_2*e!PPd{cHnGMq9e!z5?rHQOJ7fl6q3eo2^hXvEs7Vuji2Z)8?609#loa06%l-m
zho5up%gJBt83GI4VK$@clU5<|gb{b6ZM6b$(milN93-#{L0R3gn~zi3|DqqBt^%vg
zJsn|Q1Elq=NP{RWETv@v>)s|ADa1F}JZwCzzJW;HxTBs+OT4KVVwc}0@kj|U=57FE
zs$nEtQzseD5%8l6R!L|r?UqK0%8?Zp=RLl)g^K7|5H&pj;G)Y)im7{nP7U<z)HU!M
zwJ9Zk;C|19WXgmV{47dwxnL#2mSGpe)U%R+iyTM`MTk`v&M;QE{(YQ06w(+R3d02{
zz?D5J8Yz;o=2BzlQtg&gm3t@A4fA&Ane_V6^;Tih&El+MV#$a+)AjbGZoa9rp>xS{
z!u+h_c%gcuTZCit11yz3TDEg?&>Oobs0KaT0s`a2|ALweV~oZ-4!~`?JrWASbrU&d
zf{?opuRnSrL%23MVR0dU4lU1d0o!hCczU4t&*UZpFc0~Issbn#=l%W+RDg;J^MPz7
zk&t3Q8&>I~D2O*F0A3kX1ONZ@19^(bJ%gfpdMk-k()|4VO1XmGN3*55xw+B!tglaJ
zT|8@Uf702_E-x?tHSffgelEtt#U0BPYAY$B_d~spr;nDWexQ^0nj9DySZnh<TWLC5
zZE=15u9VH|e6ig>n#Rn?%6b>5Zsnr}1Sy+qX)O%I5+5HOz25J{y9H;kne;3-*e+D+
z@tBXKxSfDcv}1s06na>Zw`W&HMa2OWbZ!&A{OljdPvPnq#(|Wmc8fKXJ4NL7n73h)
zW$)nO@>30&2lRAxqoSh=qc#3;w|9R_Bj_X8a|9Io3rA1%96N4K>L$^xUqoO7n|nga
zg_3C%N5;oV`CN8W8MS<TeJ8W|LdqqY)vj;4HxhoX`(2G&=6YKUIf$K7NJW7;IANiu
zu54&oR8({?=68Ft^xYoqT2%RZP<42`r&>8A=y>3Be)kW%y^&Pe5x2vcqVe(ZUUc}u
z9&zlab78xkB#a*bwdKLvVj8PaZVCTc*W0U*@9lG!Es<UgtZgI-NP?&_j7$!MsHnhM
zF;}id_d)KNEaG2A;wg0(JA|5wWtZSPu)8ZByZdmEr>y>R)^V5nm|m}E!k74YQ+B1D
z0_s=!U%bBCt+(swMDT3*UA?|Mb-a9Bgn2qIxJFkebo;V^%Np|GGgARplNkyM$_0rY
zNv3L{6c-nl(Djsr^C{uR%XT#D$jAtbQ74Hdq4I1)Q`3h3-J0{M*y`TSluO<1s_Ue8
zIk{7l<Ay{2;})Xf=BPZT3Mi{dD1q4nfx<_*uN&$o)fL4&>t0mTl$pz0s*zwsE^kij
zv@VcBZB8)j9#w{hh6Y3WkiORajSYbK@!)qR4RSZpjVwvm?XvB9FtLEgiDTDG+Ah66
z`ES;CUrJE1aIpo`XTZWsX&hyJ@lumGcUX2@PRh5p4IkUdVm1=a3>N}7licQax8~VV
zl$Mv5_e>9)2NQx%Fh%54ISE${<LzqGQq<YG9xd8)l`e-WS8w=is^>*6s%gV7AW*EF
zNA}hF`ToLdjh&H^v1;v{r8E3udH3P!VCOlP*IAs8x6eJfWfV(P)6nB|c@IwAz`(xa
zF$kFe(ublPxwN8afdWUt$eI`MSc*So7B94KUq4eIS<q((x6YP*iEBmh<B)$hFYxvE
zXL#p%=hv%)yubl2-PMkpdA$xxv1Xp^zrQJ?RbHC+5jVfmNcf|Z^6%bUZ-!v_5HmN@
zU(hG&fe$yh;5PFZPle)11@>=L)zr4_>lX|93MCz|egrPyLISJm@1D25lD7*dwHNH2
z+U0+Wl#W~l(yt9vfJ4`Gb`-DIC0qIB&x3M;a=Yu=;6@c7I4KxOzTL{9>&3&dupf_x
zjK(FJ;-&2;@a$UDQG98mtfUm@F<8p0vaR}FxxcKTvmMnY)~DJ`!DxMBgM1<GsoI%&
z-m}AVuePp^{iW62xEJWgGXBp}`}AJUsVi$zyi$hTr&Cnha7CpK6($Kfr90psA0OLe
z@$~-lh&lNBEEDE@GW9lheWly!0qQokp4m~bP(v=&D|C<LLE44u#{|lRUc^NPChAZt
z?grl1gu!5@;418#K(XL%!}ovhPwHK|uAW|lfKq=Dc09KC2hGZxBA`O`%-s(fEI!0t
z&zJK5d$k8+86P`@&rdF(2lLOqX$FRR-ST^oWaKJxk9v+8P|ET1*BdmErOt~ypG%mx
zJq$?7U{mtMvuVV)<79s@^LaAk7C++)Klcp22nQ^%=0>Brk4ZrFssc>C7$VO#cf8r|
z?N<{5>mI$#-T8uVs;1mA_KW{`VNkR9nGrr%hC%2Q+91RD_08AzxPLT&+$I6buydE5
zG!qVpxYopT%t-HJLN8}#WbdYd&WkAVDxa!o%=+hiW#NY(1qIuUD-OL^A@}k2^<UnT
znlxVY;V9Gh`fi2cx3;yVk{>#R8hL5?$cAbz>6jLF${yI*+NOdE4f6gtX=_fPA#;2h
zM@JLPCgwEhpecKepe_jt?L+g+&nD#;&&j?4LB7^WlwUP_o~_F?COu1&-~6^CH5P3V
z77d+*W_V&Mq)u#_#A8_MF>!Bi@AvcYE7Npa7tfoIH<FBf5YY;(aDiHQnPB{TA_bjQ
zc&!N8^x*dPcHY|dw!g{eUIA>~-L>YU?d_j*PpYtyP`mNsn5=ckDO8uYmwSKbcha}E
zwkCC1nVRPqQ)87t6pc1%nQgHEX^27*+cf|05F?s!t*H2Wv_Jg6b-~>mKn6B&LaoCf
ztQMDEW<QxLM0kNHFcP@|e-n;Yg)722*N)7|DP4N4-QnZzhV-H78;im6>S}h>TzV%j
z9$rdXA#o7(e$D2Y6(L9z<qY;qBR4cplNm%rHp<J(^Ej+}-Ja;=txw~;IIF)8nLh2_
z{9^}cwe}-$SZj43u_XA8mOwVn)bzrpqN7u)-(=u@5(xhq6&3YUDJKfw!`0PQI*!B}
zDh=!Fh6-k0m%GD_jg8d^uPI-BiM6Wqm!_sR?J@kKHGggEBX%LY?~1%2Uul0!Mc;yI
zPLrC`c^10e@Zb?YToQ?E{x61w<GC{Awqu-QB|NzNtgW#XM{8>a7M6M4Ypk7f7^4gf
z(WFlu@e;%`Ng*swK7rSNr_qSHtzt=Ux8OSKeSSIWClN)`aKW?5>itJqZ4sf$%0(Y^
zT6yt7WdKJaL=OI39j2;mZf?$m-QFA_FIF4ud%E1v?D1_^Og-->%xo+SqDpNzWO;Eh
zqWIh0>5AvS)fUQDDStud?Y{nK{GBask-M|PIFw;pILstTsjoq{&(P%`{{7p1^ZL11
z>E`;{nAB+OI3AAooP@YadPk9Em7JcQK3&L{``<fB^5bQ0xJ}&wLPu2Cc4S-$1W$c4
zC|5D>#PEcJkSW5^|1}Rl+3LSuz!gO$U3HFy@>N63$8`dDdI$l3^9~VI3vCH4+u5N^
z#qQ=b$OYxB1&#?XGlG1;^zUYzEp)ufJo{pRO%&8O^_z47I<7y;yAx{yfr<DYB2Wdz
zx#l$I0peZ&4)g!50STma2LlsO@~OF%_4W0&w4|e55b=NH+*j^&+UhBi|MvLwR99Cg
z9Zx3Yu*y4DAn1MhMd3dxXQZvoYdc?oMRo6w)rjqE<?*-oD+Ui2m&qrq3g0ksWv*mQ
z`1wBuHO68(I!oDnu4+QrFXkMW0U+bd=SsaM=#k+V-DZq{!o#3$s!^_K67{06^n;WU
zHB<+Hitu8+^`9VEglqOTr!Db{k_OX$WPcVb9ah*NgEc0?^T$V@<c;xjxcFh<;$tal
zsC|xcg{0##m^5I^z@{Kleq7WGJhisgVKGkB(OZOZ+zn9M)GmF94@y7;EGb%AT7-}O
zNa9m$5hk{)X;C4E0MN{&IO`rI43Sgh)1zU>JSi6ydA+Ba_Yijbs}j|3UGfA?!oLD;
zpk|>y6lTp5BGv%HPbVMsBb8mfuV)G6PZ62A;@U8y@tEaK*>1V}MOEOYrlwRhG|Z!l
z++OTf8Y^pSISd#D4Pjw}{F>oJ*kRRQhKQzM>cX$5zqF!)9l`fd)g=pjzHr-Vbbd}_
z)+;M7xA*!v8Hx&40LY=^RPlmIY(y92e%I5|@@Y(17=I`sV%XhH8vz1=uYQ8{B&*Mx
zV#n2;k7doxyv>xMsNTllsf7g|$Mtp`Iwi0W=ufe-h}XHXl9JLCEE2+N_cLO^QE9Qb
z$_qV_WRP}`st{$wdjc4*y;LnCVqytVPik;qaD+IHQa&tFHv^^;0h!lkkZ4^6_-&kL
zWAlg70~T>CJ0<|im+KQgNl?l?&j;7%#KDne3B%4P2RW5tjvPtvW8y1^&Qx!5GDnbs
z0v`78+x>lSj^;Q+aDDG%dDbI%QqNkCS$-i(U?^N8o<s33y!la8F9MxCymN>ef!-6`
zJu5^*LzC1pirY9puc^SF!eCpUj1B7|4bd|4=PHs3URlbKf!mk)i|7P}sDgs`L4MZ3
zv-9)ZW&@~-1J>L~u;S8?|7;P`-*f+6-F6oadS@_i;H#kFkDlm47ps|AYDPws>c&`d
z5yK{`<#;pEZA8orHA-}=X3y^)o$O{b{n&62EyD^YlZDbO)s;Px_5K`~t%FUdY*$`E
zJGH;e2D2Xz9m95ci?^j925lbwVs4fTdyDqwI@!SaOd&H%#gjXqhu-ceKiuQZf)QyT
z8+^RTn)g9YW7%)9u39O8X=B?My+DE%cG`|$F^vXjXLF#i7-kuQY@G~Yi)xd<+~uir
zZ0426T;pC7Z$iPHOu)lVssOn@vFr8mI8Dz1$qf+%!)gV-|JQZ~BbhB+vMWa3WH=fO
z#*EWZZpSTN7AI3PXUcgE2A}^?7AeA!wTh#`p#97s12lsjI9z^p4uuTQB4T%Ee6&=M
zVwuPHX3HQFgZX=S$WGXzZM6IQiwzhlzo}{A%dV+^B0_R07BvJ~lV!%}SFm0hb8rQN
zogOaDlM|zFK9MQ>l$y#hZpXLfa2f8*_90((cn^*R(&?sH@WtDc5t1V@sUcA2&-kCY
zY!+h#|2;PWaB+22{2v>JMn^yXj}68%KV)gC@Q<Sf(-mSVK)kQ~&&Kn^y%g`@xxq-A
zxxW9{F>Czrq4vgskpM=StpEPVKk!w~rp)$(QjIJKkqC57dk-xuEIGV_I=g|52%Zdl
zF&NQBZT^KX=P>?>pkCQT8VHoXiQ|ki1vrd(se%JwDO@JdMq0$sP(<euA>JlA1|&eF
z^hq}1f;EWZo<=^6;HPMuz&Ep|R5%?fK-&u%q4v%uYt^H_R^A(B12s}A&d$G>`I#O+
z&FYg63%+fG0c2=+kK>rE6=tdG6&uWJ<Rg;m(=GbwG{ZtY5OPxh1$t{w7l;fNtJZL1
zl5->#5WySp-29oYPn*PJAcj!$L$`A=wlweqJO|bMLm3B5hVl)~s<1d9f9LOXAv9<j
zz1R<%8XDZ^D|BduW)>)*kpOH;C<;F8CWnajwgwUCyx=7>dV&E4FE)#j6b7wo!v>iI
z&4qN>^78WNGf^8Fz82>eD!{3b!_eojXcq*2{46<m)RZMQO(hzd>3y{y=5nDT_!xM;
zDb{va><JyE7OL)g^`XDQoo^0KtpE@Ks_s$NE)pi)uaeObm<tJOi()*mAYQmA6%|$0
z>BYs8EcB1Jqobox1-Bl+@1VA%V1xO4eB7&LfjB?aUqQ!vGdVmgn@bR26CMO)!+eSm
z?T6Nv-cX{j@S5I*yT^hnH^S-YWg{j4QE&^gclkfvnt&M&FgHD~>=F1FA|$Y>K>)uY
z(Q2)^ygsVf5}ZrtH9fNq2nYDv8%^cz?mpv1f{np;mHLfRhhu}1O(b}y#M;WLq^vB;
z7Pqa<eudkU%;8-Y98Jw;ERe{iqWpAsmd9oi%<+LQRunP2B7l!DQUY5YL=p2T8n2<g
zUM5!_a}k2cyCZW@MFJ1Q1SIg<FLUaDuCA<1mH116oe#rJL1MQRE(u>l>x%e#bbP#5
z!HhuNjRT`;fVdSt1z!3u%{ty-hbq>06Rzu^P-!4h{S?Z(6WM&4Ux2Q2vd1VS9f%1I
zbhCM38R+TRXkqWS`IJS&ux6itfGFR=IMOU`dw!=)NZv&6aUE2}Gcz;aF>0coIgy#?
z1hJt|h&xD256)NWUEH&;caGz(d3`2~x2)D}7}@1bW;n0M85g~WV<R}->iwDpotl;9
zY~R_{6<D)&Am!oVVQqaF42J@(((PWx&XH2ro<D9T0PwOc9;ZaKq&AL@XD26pHBOJ$
zhtSRq3O<W|s~b{}==YuPd(JxpdwY9|xq^g7w+{~wVPRqE?O*yLj5oLmzd(pXP@Cx?
rzc*XN;O|oh{y*th{ogII*RI_QyZrhm(Jtt}H-PLXCCMsr<KX`T-93V!

literal 0
HcmV?d00001

diff --git a/src/Test.hs b/src/Test.hs
deleted file mode 100644
index 469769f..0000000
--- a/src/Test.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-module Main where
-import Data.Maybe (fromJust)
-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 <- fromJust `fmap` 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 <- fromJust `fmap` 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
-
-
-  
\ No newline at end of file

From 8b1d818a6e233f4a1f882d690449a1aa4c19553f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 Aug 2010 12:33:07 -0400
Subject: [PATCH 042/137] Removed old test directory.

---
 test/Makefile  | 12 ----------
 test/haar.c    | 62 --------------------------------------------------
 test/test.c    | 35 ----------------------------
 test/test2.cpp | 27 ----------------------
 4 files changed, 136 deletions(-)
 delete mode 100644 test/Makefile
 delete mode 100644 test/haar.c
 delete mode 100644 test/test.c
 delete mode 100644 test/test2.cpp

diff --git a/test/Makefile b/test/Makefile
deleted file mode 100644
index e9bc41e..0000000
--- a/test/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-all: Test test-c test-cpp
-
-Test: Test.hs HOpenCV_c.c HOpenCV.h HOpenCV.chs
-	c2hs  --cppopts='-I/usr/include/opencv' -l HOpenCV.chs
-	ghc --make Test.hs HOpenCV_c.c  -lcv -lhighgui -I/usr/include/opencv  -o Test -O2
-
-
-test-c: test.c HOpenCV_c.c HOpenCV.h
-	gcc test.c HOpenCV_c.c -lcv -lhighgui -lcxcore   -I/usr/include/opencv -o test-c -O2
-
-test-cpp: test2.cpp 
-	gcc test2.cpp -lcv -lhighgui -lcxcore   -I/usr/include/opencv -o test-cpp -O2
\ No newline at end of file
diff --git a/test/haar.c b/test/haar.c
deleted file mode 100644
index 9871b3f..0000000
--- a/test/haar.c
+++ /dev/null
@@ -1,62 +0,0 @@
-#include "cv.h"
-#include "highgui.h"
-
-CvHaarClassifierCascade* load_object_detector( const char* cascade_path )
-{
-    return (CvHaarClassifierCascade*)cvLoad( cascade_path );
-}
-
-void detect_and_draw_objects( IplImage* image,
-                              CvHaarClassifierCascade* cascade,
-                              int do_pyramids )
-{
-    IplImage* small_image = image;
-    CvMemStorage* storage = cvCreateMemStorage(0);
-    CvSeq* faces;
-    int i, scale = 1;
-
-    /* if the flag is specified, down-scale the input image to get a
-       performance boost w/o loosing quality (perhaps) */
-    if( do_pyramids )
-    {
-        small_image = cvCreateImage( cvSize(image->width/2,image->height/2), IPL_DEPTH_8U, 3 );
-        cvPyrDown( image, small_image, CV_GAUSSIAN_5x5 );
-        scale = 2;
-    }
-
-    /* use the fastest variant */
-    faces = cvHaarDetectObjects( small_image, cascade, storage, 1.2, 2, CV_HAAR_DO_CANNY_PRUNING );
-
-    /* draw all the rectangles */
-    for( i = 0; i < faces->total; i++ )
-    {
-        /* extract the rectanlges only */
-        CvRect face_rect = *(CvRect*)cvGetSeqElem( faces, i );
-        cvRectangle( image, cvPoint(face_rect.x*scale,face_rect.y*scale),
-                     cvPoint((face_rect.x+face_rect.width)*scale,
-                             (face_rect.y+face_rect.height)*scale),
-                     CV_RGB(255,0,0), 3 );
-    }
-
-    if( small_image != image )
-        cvReleaseImage( &small_image );
-    cvReleaseMemStorage( &storage );
-}
-
-/* takes image filename and cascade path from the command line */
-int main( int argc, char** argv )
-{
-    IplImage* image;
-    if( argc==3 && (image = cvLoadImage( argv[1], 1 )) != 0 )
-    {
-        CvHaarClassifierCascade* cascade = load_object_detector(argv[2]);
-        detect_and_draw_objects( image, cascade, 1 );
-        cvNamedWindow( "test", 0 );
-        cvShowImage( "test", image );
-        cvWaitKey(0);
-        cvReleaseHaarClassifierCascade( &cascade );
-        cvReleaseImage( &image );
-    }
-
-    return 0;
-}
diff --git a/test/test.c b/test/test.c
deleted file mode 100644
index b07be52..0000000
--- a/test/test.c
+++ /dev/null
@@ -1,35 +0,0 @@
-#include "HOpenCV.h"
-
-void lib_test()
-{
-    CvCapture *capture = new_capture(0);
-    IplImage *frame = NULL;
-    new_window(0,1);
-
-    while (1) {
-        frame = cvQueryFrame(capture);
-        //show_image(0, frame);
-        wait_key(30);
-    }
-
-    del_window(0);
-    del_capture(capture);
-}
-
-void direct_test()
-{
-    CvCapture *capture = new_capture(0);
-    cvNamedWindow("blah",1);
-
-    while (1) {
-        cvShowImage("blah", query_frame(capture));
-        cvWaitKey(10);
-    }
-
-}
-
-int main(int argc, char *argv[])
-{
-//    direct_test();
-    lib_test();
-}
diff --git a/test/test2.cpp b/test/test2.cpp
deleted file mode 100644
index f812b1f..0000000
--- a/test/test2.cpp
+++ /dev/null
@@ -1,27 +0,0 @@
-#include "cv.h"
-#include "highgui.h"
-
-using namespace cv;
-
-int main(int, char**)
-{
-    VideoCapture cap(0); // open the default camera
-    if(!cap.isOpened())  // check if we succeeded
-        return -1;
-
-    Mat edges;
-    namedWindow("edges",1);
-    for(;;)
-    {
-        Mat frame;
-        cap >> frame; // get a new frame from camera
-        cvtColor(frame, edges, CV_BGR2GRAY);
-        GaussianBlur(edges, edges, Size(7,7), 1.5, 1.5);
-        Canny(edges, edges, 0, 30, 3);
-        imshow("edges", edges);
-        //imshow("edges", frame);
-        if(waitKey(30) >= 0) break;
-    }
-    // the camera will be deinitialized automatically in VideoCapture destructor
-    return 0;
-}

From 86ea3a9d2ca169b308f94c442afa4ad45722b6d1 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 Aug 2010 12:35:28 -0400
Subject: [PATCH 043/137] Added note about optimizations to README.

---
 README | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README b/README
index 210d0c3..eba3565 100644
--- a/README
+++ b/README
@@ -9,7 +9,7 @@ OpenCV 2.1 bindings for Haskell.
 
 - When operations are directly composed, they will be performed
   in-place where possible as the intermediate images are not
-  observable.
+  observable. GHC's optimizations must be enabled (e.g. -Odph).
 
 NOTE: Only a small part of OpenCV is currently wrapped.
 

From 883141a82167528e843a8964e081ee94ceb317d0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 Aug 2010 14:23:19 -0400
Subject: [PATCH 044/137] Moved low-level modules into the Core directory.

The reorganization should make it more clear which modules a user is
likely to be interested in (namely, those not in the Core directory).

- Cleaned out some dead code from PixelUtils.
- Improved comment accuracy in most modules.
- Renamed HighColorConv to ColorConversion. The old name was terrible.
- Updated the .cabal file to include a brief usage note.
---
 HOpenCV.cabal                                 | 28 ++++----
 src/AI/CV/OpenCV/ArrayOps.hs                  | 15 ++--
 .../{HighColorConv.hs => ColorConversion.hs}  |  8 +--
 src/AI/CV/OpenCV/Contours.hsc                 |  4 +-
 src/AI/CV/OpenCV/{ => Core}/CV.hsc            |  6 +-
 .../CV/OpenCV/{ => Core}/ColorConversion.hsc  |  2 +-
 src/AI/CV/OpenCV/{ => Core}/CxCore.hsc        |  2 +-
 src/AI/CV/OpenCV/{ => Core}/HIplImage.hsc     | 25 ++++---
 src/AI/CV/OpenCV/{ => Core}/HIplUtils.hs      | 66 +++++++++--------
 src/AI/CV/OpenCV/{ => Core}/HOpenCV_wrap.c    |  0
 src/AI/CV/OpenCV/{ => Core}/HOpenCV_wrap.h    |  0
 src/AI/CV/OpenCV/{ => Core}/HighGui.hsc       | 25 +++----
 src/AI/CV/OpenCV/FeatureDetection.hs          |  4 +-
 src/AI/CV/OpenCV/Filtering.hsc                | 12 ++--
 src/AI/CV/OpenCV/HighCV.hs                    | 71 ++++++++++++-------
 src/AI/CV/OpenCV/Motion.hsc                   |  8 +--
 src/AI/CV/OpenCV/PixelUtils.hs                | 53 ++------------
 src/AI/CV/OpenCV/Threshold.hs                 | 39 +++++-----
 src/AI/CV/OpenCV/Types.hs                     | 11 ---
 19 files changed, 181 insertions(+), 198 deletions(-)
 rename src/AI/CV/OpenCV/{HighColorConv.hs => ColorConversion.hs} (91%)
 rename src/AI/CV/OpenCV/{ => Core}/CV.hsc (98%)
 rename src/AI/CV/OpenCV/{ => Core}/ColorConversion.hsc (98%)
 rename src/AI/CV/OpenCV/{ => Core}/CxCore.hsc (99%)
 rename src/AI/CV/OpenCV/{ => Core}/HIplImage.hsc (90%)
 rename src/AI/CV/OpenCV/{ => Core}/HIplUtils.hs (79%)
 rename src/AI/CV/OpenCV/{ => Core}/HOpenCV_wrap.c (100%)
 rename src/AI/CV/OpenCV/{ => Core}/HOpenCV_wrap.h (100%)
 rename src/AI/CV/OpenCV/{ => Core}/HighGui.hsc (86%)
 delete mode 100644 src/AI/CV/OpenCV/Types.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 76a0e8b..0a91c8f 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,11 +1,12 @@
 name: HOpenCV
 version: 0.1.2.2.1
 license: BSD3
-maintainer: Noam Lewis <jones.noamle@gmail.com>
-bug-reports: mailto:jones.noamle@gmail.com
+author: Noam Lewis <jones.noamle@gmail.com>
+maintainer: Anthony Cowley <acowley@gmail.com>
+stability: experimental
 category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
-Tested-With:   GHC == 6.12.1
+Tested-With:   GHC==6.12.1, GHC==6.12.3
 description:
    Limited bindings to OpenCV 2.1. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
@@ -13,26 +14,27 @@ description:
    .
    You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04 and Mac OS 10.5 and 10.6.
    .
-   
+   /Usage/
+   .
+   The "AI.CV.OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations.
 build-type:         Simple
 cabal-version:      >= 1.2
-extra-source-files: src/AI/CV/OpenCV/HOpenCV_wrap.h
+extra-source-files: src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
 source-repository head
   type: git
   location: git://github.com/acowley/HOpenCV.git
 
 library
    exposed-modules:
-      AI.CV.OpenCV.CV
-      AI.CV.OpenCV.CxCore
-      AI.CV.OpenCV.HighGui
-      AI.CV.OpenCV.Types
-      AI.CV.OpenCV.HIplImage
-      AI.CV.OpenCV.HIplUtils
+      AI.CV.OpenCV.Core.CV
+      AI.CV.OpenCV.Core.CxCore
+      AI.CV.OpenCV.Core.HighGui
+      AI.CV.OpenCV.Core.HIplImage
+      AI.CV.OpenCV.Core.HIplUtils
+      AI.CV.OpenCV.Core.ColorConversion
       AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
-      AI.CV.OpenCV.HighColorConv
       AI.CV.OpenCV.Motion
       AI.CV.OpenCV.Contours
       AI.CV.OpenCV.Threshold
@@ -40,7 +42,7 @@ library
       AI.CV.OpenCV.Filtering
       AI.CV.OpenCV.FeatureDetection
    c-sources:
-      src/AI/CV/OpenCV/HOpenCV_wrap.c
+      src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
    hs-Source-Dirs: src
    extra-libraries: cxcore,cv,highgui
    build-depends: base >=4 && <5, 
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 1f39158..bda6d44 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -7,8 +7,8 @@ import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.CxCore (CvArr, IplImage)
-import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
+import AI.CV.OpenCV.Core.HIplUtils
 
 foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -130,10 +130,11 @@ cvAndAux :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> IO (
 cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
                                       (castPtr dst) (castPtr mask)
 
--- |Calculate the per-element bitwise conjunction of two arrays. The
--- mask specifies the elements of the result that will be computed via
--- the conjunction, and those that will simply be copied from the
--- third parameter 'HIplImage' (i.e. the second source array)
+-- |Calculate the per-element bitwise conjunction of two
+-- arrays. Parameters are a mask and two source images. The mask
+-- specifies the elements of the result that will be computed via the
+-- conjunction, and those that will simply be copied from the third
+-- parameter.
 cvAndMask :: (HasChannels c, HasDepth d, Storable d) => 
              HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
              HIplImage b c d -> HIplImage FreshImage c d
@@ -175,4 +176,4 @@ unsafeAndMask mask src1 src2 = unsafePerformIO $
 {-# RULES "cvAndMask/in-place"
     forall m s (g :: a -> HIplImage FreshImage c d).
     cvAndMask m s . g = unsafeAndMask m s . g 
-  #-}
\ No newline at end of file
+  #-}
diff --git a/src/AI/CV/OpenCV/HighColorConv.hs b/src/AI/CV/OpenCV/ColorConversion.hs
similarity index 91%
rename from src/AI/CV/OpenCV/HighColorConv.hs
rename to src/AI/CV/OpenCV/ColorConversion.hs
index de3621f..7570b98 100644
--- a/src/AI/CV/OpenCV/HighColorConv.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -1,10 +1,10 @@
 -- |Type-safe color conversion functions. 
-module AI.CV.OpenCV.HighColorConv 
+module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
      convertBGRToGray, convertRGBToGray) where
-import AI.CV.OpenCV.CV
-import AI.CV.OpenCV.HIplUtils
-import AI.CV.OpenCV.ColorConversion
+import AI.CV.OpenCV.Core.CV
+import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.ColorConversion
 import Control.Monad.ST (runST, unsafeIOToST)
 import Foreign.Storable (Storable)
 
diff --git a/src/AI/CV/OpenCV/Contours.hsc b/src/AI/CV/OpenCV/Contours.hsc
index ae72a77..46a3344 100644
--- a/src/AI/CV/OpenCV/Contours.hsc
+++ b/src/AI/CV/OpenCV/Contours.hsc
@@ -2,7 +2,7 @@
 -- |Incomplete support for cvFindContours.
 module AI.CV.OpenCV.Contours (ContourMode(..), ContourMethod(..), 
                               cvFindContours, followContourList) where
-import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.Core.CxCore
 import Foreign.C.Types (CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable
@@ -55,8 +55,6 @@ data ContourMethod = CV_CHAIN_APPROX_NONE
                    -- algorithm by linking horizontal segments of
                    -- 1's. Only the CV_RETR_LIST retrieval mode can be
                    -- used with this method.  
-
-                   -- | CV_CHAIN_CODE -- changes returned sequence type
                      deriving Enum
 
 -- |The function retrieves 'CvContour's from the binary image using the
diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
similarity index 98%
rename from src/AI/CV/OpenCV/CV.hsc
rename to src/AI/CV/OpenCV/Core/CV.hsc
index 03dc147..e6ef461 100644
--- a/src/AI/CV/OpenCV/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables #-}
 -- |Support for features from the OpenCV Image Filtering library.
-module AI.CV.OpenCV.CV 
+module AI.CV.OpenCV.Core.CV 
     ( InterpolationMethod(..),
       cvCanny, cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
       CvHaarClassifierCascade, HaarDetectFlag,
@@ -17,8 +17,8 @@ import Foreign.Marshal.Array (peekArray)
 import Foreign.Storable (Storable, sizeOf)
 import Foreign.Ptr
 import Data.Bits
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.ColorConversion
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.ColorConversion
 
 #include <opencv/cv.h>
 
diff --git a/src/AI/CV/OpenCV/ColorConversion.hsc b/src/AI/CV/OpenCV/Core/ColorConversion.hsc
similarity index 98%
rename from src/AI/CV/OpenCV/ColorConversion.hsc
rename to src/AI/CV/OpenCV/Core/ColorConversion.hsc
index e1751d5..d346840 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hsc
+++ b/src/AI/CV/OpenCV/Core/ColorConversion.hsc
@@ -1,5 +1,5 @@
 -- |Constants for color conversion
-module AI.CV.OpenCV.ColorConversion where
+module AI.CV.OpenCV.Core.ColorConversion where
 import Foreign.C.Types (CInt)
 
 #include <opencv/cv.h>
diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
similarity index 99%
rename from src/AI/CV/OpenCV/CxCore.hsc
rename to src/AI/CV/OpenCV/Core/CxCore.hsc
index 98fafdb..c86c6ab 100644
--- a/src/AI/CV/OpenCV/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
 
-module AI.CV.OpenCV.CxCore where
+module AI.CV.OpenCV.Core.CxCore where
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.ForeignPtr
diff --git a/src/AI/CV/OpenCV/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
similarity index 90%
rename from src/AI/CV/OpenCV/HIplImage.hsc
rename to src/AI/CV/OpenCV/Core/HIplImage.hsc
index 435d8c3..7cf4b61 100644
--- a/src/AI/CV/OpenCV/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,12 +1,12 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
-module AI.CV.OpenCV.HIplImage 
+module AI.CV.OpenCV.Core.HIplImage 
     ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), width, height, imageData, imageSize, widthStep, 
       mkHIplImage, withHIplImage, bytesPerPixel, ByteOrFloat) where
-import AI.CV.OpenCV.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
-                            iplDepth32f, iplDepth64f)
-import AI.CV.OpenCV.CV (cvCvtColor)
-import AI.CV.OpenCV.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
+import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
+                                 iplDepth32f, iplDepth64f)
+import AI.CV.OpenCV.Core.CV (cvCvtColor)
+import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (complement, (.&.))
@@ -92,10 +92,13 @@ bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
     where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
 
--- |A Haskell data structure representing the information OpenCV uses
--- from an 'IplImage' struct. It includes the pixel origin, image
--- width, image height, image size (number of bytes), a pointer to the
--- pixel data, and the row stride.
+-- |A data structure representing the information OpenCV uses from an
+-- 'IplImage' struct. It includes the pixel origin, image width, image
+-- height, image size (number of bytes), a pointer to the pixel data,
+-- and the row stride. Its type is parameterized by whether or not the
+-- backing pixel data is fresh (vs shared), the number of color
+-- channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the pixel
+-- depth (e.g. 'Word8', 'Float').
 data HIplImage a c d where
     HIplImage :: (HasChannels c, HasDepth d, Storable d) => 
                  Int -> Int -> Int -> Int -> ForeignPtr d -> Int -> 
@@ -111,8 +114,8 @@ widthStep (HIplImage _ _ _ _ _ s) = s
 imageData :: HIplImage a c d -> ForeignPtr d
 imageData (HIplImage _ _ _ _ d _) = d
 
--- |Prepare an 8-bit-per-pixel 'HIplImage' of the given width, height,
--- and number of color channels with an allocated pixel buffer.
+-- |Prepare a 'HIplImage' of the given width and height. The pixel and
+-- color depths are gleaned from the type, and may often be inferred.
 mkHIplImage :: forall c d. (HasChannels c, HasDepth d, Storable d) => 
                Int -> Int -> IO (HIplImage FreshImage c d)
 mkHIplImage w h = 
diff --git a/src/AI/CV/OpenCV/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
similarity index 79%
rename from src/AI/CV/OpenCV/HIplUtils.hs
rename to src/AI/CV/OpenCV/Core/HIplUtils.hs
index 4686ddd..4f3cb30 100644
--- a/src/AI/CV/OpenCV/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -1,17 +1,18 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |Functions for working with 'HIplImage's.
-module AI.CV.OpenCV.HIplUtils (isColor, isMono, imgChannels, withPixels, pixels,
-                               fromPtr, fromFileColor, fromFileGray, toFile, 
-                               compatibleImage, duplicateImage, fromPixels, 
-                               withImagePixels, fromGrayPixels, fromColorPixels,
-                               withDuplicateImage, withCompatibleImage, 
-                               HIplImage, mkHIplImage, width, height, 
-                               withHIplImage, FreshImage, MonoChromatic, 
-                               TriChromatic, HasChannels, HasDepth(..), 
-                               ByteOrFloat) where
-import AI.CV.OpenCV.CxCore (IplImage)
-import AI.CV.OpenCV.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
-import AI.CV.OpenCV.HIplImage
+module AI.CV.OpenCV.Core.HIplUtils 
+    (isColor, isMono, imgChannels, withPixels, pixels,
+     fromPtr, fromFileColor, fromFileGray, toFile, 
+     compatibleImage, duplicateImage, fromPixels, 
+     withImagePixels, fromGrayPixels, fromColorPixels,
+     withDuplicateImage, withCompatibleImage, 
+     HIplImage, mkHIplImage, width, height, 
+     withHIplImage, FreshImage, MonoChromatic, 
+     TriChromatic, HasChannels, HasDepth(..), 
+     ByteOrFloat) where
+import AI.CV.OpenCV.Core.CxCore (IplImage)
+import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
+import AI.CV.OpenCV.Core.HIplImage
 import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8)
@@ -35,6 +36,8 @@ isMono = id
 {-# INLINE isMono #-}
 {-# INLINE isColor #-}
 
+-- |Return the number of color channels a 'HIplImage' has as a runtime
+-- value.
 imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
@@ -49,9 +52,8 @@ withPixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
 doST :: IO a -> a
 doST x = runST (unsafeIOToST x)
 
--- |Return a 'V.Vector' containing the pixels that make up an
--- 8-bit-per-pixel 'HIplImage'. This makes a copy of the underlying
--- pixel data.
+-- |Return a 'V.Vector' containing a copy of the pixels that make up a
+-- 'HIplImage'.
 pixels :: Storable d => HIplImage a c d -> V.Vector d
 pixels img = doST $ do ptr <- mallocForeignPtrBytes len
                        withForeignPtr ptr $ \dst -> 
@@ -60,7 +62,7 @@ pixels img = doST $ do ptr <- mallocForeignPtrBytes len
                        return $ V.unsafeFromForeignPtr ptr 0 len
     where len = imageSize img
 
--- |Read an 'HIplImage' from a 'Ptr' 'IplImage'
+-- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
 fromPtr :: (HasChannels c, HasDepth d, Storable d) => 
            Ptr IplImage -> IO (HIplImage () c d)
 fromPtr = peek . castPtr
@@ -70,25 +72,25 @@ checkFile :: FilePath -> IO ()
 checkFile f = do e <- doesFileExist f
                  if e then return () else error $ "Can't find "++f
 
--- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
--- image will have three color channels.
-fromFileColor :: String -> IO (HIplImage FreshImage TriChromatic Word8)
+-- |Load a color 'HIplImage' from an 8-bit image file. If the image
+-- file is grayscale, it will be converted to color.
+fromFileColor :: FilePath -> IO (HIplImage FreshImage TriChromatic Word8)
 fromFileColor fileName = do checkFile fileName
                             ptr <- cvLoadImage fileName LoadColor
                             img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
                             return $ unsafeCoerce img
 
--- |Load an 'HIplImage' from an 8-bit image file on disk. The returned
--- image will have a single color channel.
-fromFileGray :: String -> IO (HIplImage FreshImage MonoChromatic Word8)
---fromFileGray fileName = unsafeCoerce . fromPtr =<< cvLoadImage fileName LoadGray
+-- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
+-- image file is color, it will be converted to grayscale.
+fromFileGray :: FilePath -> IO (HIplImage FreshImage MonoChromatic Word8)
 fromFileGray fileName = do checkFile fileName
                            ptr <- cvLoadImage fileName LoadGray
                            img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
                            return $ unsafeCoerce img
 
+-- |Save a 'HIplImage' to the specified file.
 toFile :: (HasChannels c, HasDepth d, Storable d) => 
-          String -> HIplImage a c d -> IO ()
+          FilePath -> HIplImage a c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 
@@ -138,7 +140,7 @@ withImagePixels w h pix f = if fromIntegral len == sz
 {-# INLINE [0] withImagePixels #-}
 
 -- |Construct a fresh 'HIplImage' from a width, a height, and a
--- 'V.Vector' of 8-bit pixel values.
+-- 'V.Vector' of pixel values.
 fromPixels :: forall a c d. 
               (Integral a, HasChannels c, HasDepth d, Storable d) =>
               a -> a -> V.Vector d -> HIplImage FreshImage c d
@@ -158,15 +160,17 @@ fromPixels w h pix = doST $ do fp <- copyData
 {-# INLINE [0] fromPixels #-}
 
 -- |Helper function to explicitly type a vector of monochromatic pixel
--- data.
-fromGrayPixels :: Integral a => 
-                  a -> a -> V.Vector Word8 -> HIplImage FreshImage MonoChromatic Word8
+-- data. Parameters are the output image's width, height, and pixel
+-- content.
+fromGrayPixels :: (HasDepth d, Storable d, Integral a) => 
+                  a -> a -> V.Vector d -> HIplImage FreshImage MonoChromatic d
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of trichromatic pixel
--- data.
-fromColorPixels :: Integral a =>
-                   a -> a -> V.Vector Word8 -> HIplImage FreshImage TriChromatic Word8
+-- data. Parameters are the output image's width, height, and pixel
+-- content.
+fromColorPixels :: (HasDepth d, Storable d, Integral a) =>
+                   a -> a -> V.Vector d -> HIplImage FreshImage TriChromatic d
 fromColorPixels w h = isColor . fromPixels w h
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
similarity index 100%
rename from src/AI/CV/OpenCV/HOpenCV_wrap.c
rename to src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
similarity index 100%
rename from src/AI/CV/OpenCV/HOpenCV_wrap.h
rename to src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
diff --git a/src/AI/CV/OpenCV/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
similarity index 86%
rename from src/AI/CV/OpenCV/HighGui.hsc
rename to src/AI/CV/OpenCV/Core/HighGui.hsc
index ea59afa..55a8e46 100644
--- a/src/AI/CV/OpenCV/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -1,11 +1,12 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
-module AI.CV.OpenCV.HighGui (cvLoadImage, LoadColor(..), cvSaveImage, 
-                             CvCapture, cvCreateCameraCapture, 
-                             createCameraCaptureF, createFileCaptureF,
-                             cvCreateFileCapture, setCapturePos, 
-                             CapturePos(..), cvQueryFrame,
-                             newWindow, delWindow, showImage, waitKey,
-                             cvConvertImage) where
+module AI.CV.OpenCV.Core.HighGui 
+    (cvLoadImage, LoadColor(..), cvSaveImage, 
+     CvCapture, cvCreateCameraCapture, 
+     createCameraCaptureF, createFileCaptureF,
+     cvCreateFileCapture, setCapturePos, 
+     CapturePos(..), cvQueryFrame,
+     newWindow, delWindow, showImage, waitKey,
+     cvConvertImage, c_debug_ipl) where
  
 import Foreign.ForeignPtrWrap
 import Foreign.C.Types
@@ -13,7 +14,7 @@ import Foreign.Ptr
 import Foreign.ForeignPtr
 import Foreign.C.String
  
-import AI.CV.OpenCV.CxCore
+import AI.CV.OpenCV.Core.CxCore
 
 #include <opencv/highgui.h>
 
@@ -57,7 +58,7 @@ data CvCapture
 foreign import ccall unsafe "highgui.h cvCreateCameraCapture"
   c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
                           
-cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
+cvCreateCameraCapture :: Int -> IO (Ptr CvCapture)
 cvCreateCameraCapture = errorName "Failed to create camera" . checkPtr . 
                         c_cvCreateCameraCapture . fromIntegral
   
@@ -89,13 +90,13 @@ posEnum (PosRatio r) = (#{const CV_CAP_PROP_POS_AVI_RATIO}, realToFrac r)
 setCapturePos :: Ptr CvCapture -> CapturePos -> IO ()
 setCapturePos cap pos = uncurry (c_cvSetCaptureProperty cap) $ posEnum pos
   
-foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
-  release_capture  :: Ptr CvCapture -> IO ()
+-- foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
+--   release_capture  :: Ptr CvCapture -> IO ()
 
 foreign import ccall unsafe "HOpenCV_wrap.h &release_capture"
   cp_release_capture  :: FunPtr (Ptr CvCapture -> IO ())
  
-createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture)
+createCameraCaptureF :: Int -> IO (ForeignPtr CvCapture)
 createCameraCaptureF = createForeignPtr cp_release_capture . cvCreateCameraCapture
 
 createFileCaptureF :: String -> IO (ForeignPtr CvCapture)
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index a5bcae4..13bdd4f 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -5,8 +5,8 @@ import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplUtils
 
 foreign import ccall unsafe "opencv/cv.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index bd89b4b..446bd18 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -5,8 +5,8 @@ import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplUtils
 
 #include <opencv/cv.h>
 
@@ -30,8 +30,8 @@ cvGaussian = #{const CV_GAUSSIAN}
 -- 'HIplImage'. The kernel height will be set to the same value as the
 -- width, and the Gaussian standard deviation will be calculated from
 -- the kernel size. This function is the same as calling
--- @smoothGaussian' width Nothing Nothing@. This operation may be
--- performed in-place under composition.
+-- @smoothGaussian' width Nothing Nothing@. May be performed in-place
+-- under composition.
 smoothGaussian :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
                   Int -> HIplImage a c d -> HIplImage FreshImage c d
 smoothGaussian w = smoothGaussian' w Nothing Nothing
@@ -40,8 +40,8 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 -- Gaussian kernel. Parameters are the kernel width, the kernel height
 -- (if 'Nothing', the height will be set to the same value as the
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
--- calculated from the kernel size), and the source image. This
--- operation may be performed in-place under composition.
+-- calculated from the kernel size), and the source image. May be
+-- performed in-place under composition.
 smoothGaussian' :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
                    HIplImage FreshImage c d
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 4d10c4a..a2dfa72 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,20 +6,22 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             LineType(..), RGB, drawLines, HIplImage, width, 
                             height, pixels, withPixels, fromGrayPixels, 
                             fromColorPixels, fromFileGray, fromFileColor, 
-                            toFile, findContours, fromPtr, isColor, isMono, 
+                            toFile, fromPtr, isColor, isMono, 
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, cannyEdges, createFileCapture, 
-                            resize, InterpolationMethod(..),
-                            MonoChromatic, TriChromatic, FreshImage,
-                            module AI.CV.OpenCV.HighColorConv)
+                            createCameraCapture, resize, 
+                            InterpolationMethod(..), MonoChromatic, 
+                            TriChromatic, FreshImage,
+                            module AI.CV.OpenCV.ColorConversion)
     where
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.CV
-import AI.CV.OpenCV.HighColorConv
-import AI.CV.OpenCV.HighGui (createFileCaptureF, cvQueryFrame, setCapturePos, 
-                             CapturePos(PosFrames), CvCapture)
-import AI.CV.OpenCV.HIplUtils
-import AI.CV.OpenCV.Contours
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.CV
+import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, 
+                                  setCapturePos, CapturePos(PosFrames), 
+                                  CvCapture, createCameraCaptureF)
+import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.ColorConversion
+--import AI.CV.OpenCV.Contours
 import Control.Monad.ST (runST, unsafeIOToST)
 import Data.Word (Word8)
 import Foreign.Ptr
@@ -48,8 +50,8 @@ dilate n img = runST $
     where n' = fromIntegral n
 
 -- |Unsafe in-place erosion. This is a destructive update of the given
--- image and is only used by the fusion rewrite rules when there is
--- no way to observe the input image.
+-- image and is only used by the rewrite rules when there is no way to
+-- observe the input image.
 unsafeErode :: (HasChannels c, HasDepth d, Storable d) =>
                Int -> HIplImage a c d -> HIplImage FreshImage c d
 unsafeErode n img = runST $ 
@@ -59,8 +61,8 @@ unsafeErode n img = runST $
     where n' = fromIntegral n
 
 -- |Unsafe in-place dilation. This is a destructive update of the
--- given image and is only used by the fusion rewrite rules when
--- there is no way to observe the input image.
+-- given image and is only used by the rewrite rules when there is no
+-- way to observe the input image.
 unsafeDilate :: (HasChannels c, HasDepth d, Storable d) =>
                 Int -> HIplImage a c d-> HIplImage FreshImage c d
 unsafeDilate n img = runST $ 
@@ -81,15 +83,19 @@ unsafeDilate n img = runST $
   #-}
 
 -- |Extract all the pixel values from an image along a line, including
--- the end points. Takes two points, the line connectivity to use when
--- sampling, and an image; returns the list of pixel values.
+-- the end points. Parameters are the two endpoints, the line
+-- connectivity to use when sampling, and an image; returns the list
+-- of pixel values.
 sampleLine :: (HasChannels c, HasDepth d, Storable d) =>
               (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage a c d -> [d]
 sampleLine pt1 pt2 conn img = runST $ unsafeIOToST $ 
                               withHIplImage img $ 
                                 \p -> cvSampleLine p pt1 pt2 conn
 
--- |Line detection in a binary image using a standard Hough transform.
+-- |Line detection in a binary image using a standard Hough
+-- transform. Parameters are @rho@, the distance resolution in
+-- pixels; @theta@, the angle resolution in radians; @threshold@, the
+-- line classification accumulator threshold; and the input image.
 houghStandard :: Double -> Double -> Int -> HIplImage a MonoChromatic Word8 -> 
                  [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = runST $ unsafeIOToST $
@@ -115,7 +121,10 @@ houghStandard rho theta threshold img = runST $ unsafeIOToST $
           clampX x = max 0 (min (truncate x) (width img - 1))
           clampY y = max 0 (min (truncate y) (height img - 1))
 
--- |Line detection in a binary image using a probabilistic Hough transform.
+-- |Line detection in a binary image using a probabilistic Hough
+-- transform. Parameters are @rho@, the distance resolution in pixels;
+-- @theta@, the angle resolution in radians; @threshold@, the line
+-- classification accumulator threshold; and the input image.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
                       HIplImage a MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
@@ -153,7 +162,7 @@ lineTypeEnum AALine    = 16
 
 -- |Draw each line, defined by its endpoints, on a duplicate of the
 -- given 'HIplImage' using the specified RGB color, line thickness,
--- and aliasing style. This function is fusible under composition.
+-- and aliasing style.
 drawLines :: (HasChannels c, HasDepth d, Storable d) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
              HIplImage a c d -> HIplImage FreshImage c d
@@ -178,9 +187,10 @@ unsafeDrawLines col thick lineType lines img =
   #-}
 
 -- |Find edges using the Canny algorithm. The smallest value between
--- threshold1 and threshold2 is used for edge linking, the largest
--- value is used to find the initial segments of strong edges. The
--- third parameter is the aperture parameter for the Sobel operator.
+-- threshold1 and threshold2 (the first two parameters, respectively)
+-- is used for edge linking, the largest value is used to find the
+-- initial segments of strong edges. The third parameter is the
+-- aperture parameter for the Sobel operator.
 cannyEdges :: (HasDepth d, Storable d) =>
               Double -> Double -> Int -> HIplImage a MonoChromatic d -> 
               HIplImage FreshImage MonoChromatic d
@@ -203,10 +213,12 @@ unsafeCanny threshold1 threshold2 aperture img =
     cannyEdges t1 t2 a . g = unsafeCanny t1 t2 a . g
   #-}
 
+{-
 -- |Find the 'CvContour's in an image.
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
+-}
 
 -- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
 -- returns a 'Ptr' 'IplImage'.
@@ -223,7 +235,7 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
                                         queryError cap
                           Just f' -> return f'
 
--- |Open a capture stream from a movie file. The action returned may
+-- |Open a capture stream from a movie file. The returned action may
 -- be used to query for the next available frame.
 createFileCapture :: (HasChannels c, HasDepth d, Storable d) =>
                      FilePath -> IO (IO (HIplImage () c d))
@@ -231,6 +243,17 @@ createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ 
                                      (>>= fromPtr) . queryFrameLoop)
 
+-- |Open a capture stream from a connected camera. The parameter is
+-- the index of the camera to be used, or 'Nothing' if it does not
+-- matter what camera is used. The returned action may be used to
+-- query for the next available frame.
+createCameraCapture :: (HasChannels c, HasDepth d, Storable d) =>
+                       Maybe Int -> IO (IO (HIplImage () c d))
+createCameraCapture cam = do capture <- createCameraCaptureF cam'
+                             return (withForeignPtr capture $ 
+                                     (>>= fromPtr) . queryError)
+    where cam' = maybe (-1) id cam
+
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
 resize :: (HasChannels c, HasDepth d, Storable d) => 
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index bc22ee1..6a13f49 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -5,16 +5,16 @@ import Data.Word (Word8)
 import Foreign.C.Types (CInt)
 import Foreign.Ptr (Ptr)
 import System.IO.Unsafe
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.HIplImage
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplImage
 
 foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
   c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
                            CInt -> CInt -> CInt -> CInt -> 
                            CInt -> Ptr CvArr -> Ptr CvArr -> IO ()
 
--- |Calculates the optical flow for two images by using the block
--- matching method. The third parameter is the width and height of
+-- |Calculates the optical flow between two images using the block
+-- matching method. The third parameter is the width and height of the
 -- blocks to be compared; the fourth parameter is the block coordinate
 -- increments; the fifth is the size of the scanned neighborhood in
 -- pixels around the block. The result is a pair of the horizontal and
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 73fe53f..964fa95 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -1,41 +1,18 @@
 {-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
 -- |Images obtained from OpenCV usually have the components of color
 -- pixels arranged in BGR order and pad image rows with unused
--- bytes. This module provides mechanisms to re-order pixels to RGB
--- and to drop the unused packing bytes.
+-- bytes. This module provides mechanisms to drop the unused packing
+-- bytes.
 module AI.CV.OpenCV.PixelUtils where
-import AI.CV.OpenCV.HIplImage
-import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Core.HIplImage
+import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.ColorConversion (convertRGBToGray)
 import Control.Monad.ST (runST)
 import Data.Vector.Storable (Storable)
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as VM
 import qualified Data.Vector.Generic as VG
-
--- |Generate indices to convert OpenCV-native BGR pixel ordering to
--- RGB and drop unused packing bytes from each row. The returned index
--- 'V.Vector' may be passed to 'toRGB'' to speed up pixel ordering
--- conversion when multiple conversions are to be performed.
-rgbIndices :: Int -> Int -> Int -> V.Vector Int
-rgbIndices width' stride numElems = V.fromList $ concatMap row rowStarts
-    where rowStarts = [0,stride..numElems-1]
-          row s = concatMap (\c -> map (s + c*3 +) [2,1,0]) [0..width'-1]
-
--- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded rows
--- to tightly packed rows of RGB pixels.
-toRGB :: (HasDepth d, Storable d) => HIplImage a TriChromatic d -> V.Vector d
-toRGB img = V.backpermute (pixels img) $
-            rgbIndices (width img) (widthStep img) (imageSize img)
-{-# INLINE toRGB #-}
-
--- |Convert an 'HIplImage' \'s pixel data from BGR triplets in padded
--- rows to tightly packed rows of RGB pixels using the given
--- 'V.Vector' of indices. The index 'Vector' will typically be the
--- result of a previous call to 'rgbIndices'.
-toRGB' :: (HasDepth d, Storable d) => 
-          HIplImage a TriChromatic d -> V.Vector Int -> V.Vector d
-toRGB' img inds = V.backpermute (pixels img) inds
-{-# INLINE toRGB' #-}
+import Unsafe.Coerce (unsafeCoerce)
 
 -- |OpenCV often stores color images with rows that are four times the
 -- width (which aligns rows nicely, and can accommodate RGBA
@@ -94,21 +71,5 @@ isolateChannel ch img =
 toMono :: forall a c d. (HasChannels c, HasDepth d, Storable d, Integral d) => 
           HIplImage a c d -> V.Vector d
 toMono img = if imgChannels img == 1 then packPixels img
-             else runST $ do v <- VM.new (w*h)
-                             let go !x !p !p3 !y
-                                     | y >= h = VG.unsafeFreeze v
-                                     | x == w = go 0 p (p3+margin) (y+1)
-                                     | otherwise = let grey = getAvg p3
-                                                   in do VM.unsafeWrite v p grey
-                                                         go (x+1) (p+1) (p3+3) y
-                             go 0 0 0 0
-    where w = width img
-          h = height img
-          margin = widthStep img - (w * 3)
-          pix = pixels img
-          get = fromIntegral . V.unsafeIndex pix
-          getAvg i = avg (get i) (get (i+1)) (get (i+2))
-          avg :: Int -> Int -> Int -> d
-          avg b g r = fromIntegral $ (b + g + r) `div` 3
-{-# INLINE toMono #-}          
+             else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
 
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 214a441..4e1abc7 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -12,8 +12,8 @@ import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.CxCore 
-import AI.CV.OpenCV.HIplUtils
+import AI.CV.OpenCV.Core.CxCore 
+import AI.CV.OpenCV.Core.HIplUtils
 
 data ThresholdType = ThreshBinary
                    | ThreshBinaryInv
@@ -80,13 +80,13 @@ unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
 
--- |Binary thresholding. Each pixel is mapped to zero or
--- @maxValue@. If @inverse@ is 'False', then pixels whose value is
--- greater than @threshold@ are mapped to @maxValue@; if @inverse@ is
--- 'True', then pixels whose value is less than or equal to
--- @threshold@ are mapped to @maxValue@.  Takes the source
--- 'HIplImage', the @threshold@ value, the @maxValue@ passing pixels
--- are mapped to, and the @inverse@ flag.
+-- |Binary thresholding. Parameters are the @threshold@ value, the
+-- @maxValue@ passing pixels are mapped to, an @inverse@ flag, and the
+-- source 'HIplImage'. Each pixel is mapped to zero or @maxValue@. If
+-- @inverse@ is 'False', then pixels whose value is greater than
+-- @threshold@ are mapped to @maxValue@; if @inverse@ is 'True', then
+-- pixels whose value is less than or equal to @threshold@ are mapped
+-- to @maxValue@.
 thresholdBinary :: (ByteOrFloat d, HasDepth d, Storable d) =>
                    d -> d -> Bool -> HIplImage a MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
@@ -104,9 +104,10 @@ unsafeThreshBin th maxValue inverse = unsafeCvThreshold1 th maxValue tType
   thresholdBinary th mv f . g = unsafeThreshBin th mv f . g
   #-}
 
--- |Maps pixels that are greater than @threshold@ to the @threshold@
--- value; leaves all other pixels unchanged. Takes the source
--- 'HIplImage' and the @threshold@ value.
+-- |Truncation thresholding (i.e. clamping). Parameters are the
+-- @threshold@ value and the source 'HIplImage'. Maps pixels that are
+-- greater than @threshold@ to the @threshold@ value; leaves all other
+-- pixels unchanged.
 thresholdTruncate :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
                      d -> HIplImage a MonoChromatic d ->
                      HIplImage FreshImage MonoChromatic d
@@ -124,8 +125,8 @@ unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged. If @inverse@ is 'True', the
--- operation's meaning is reversed. Takes the source 'HIplImage', the
--- @threshold@ value, and the @inverse@ flag.
+-- operation's meaning is reversed. Parameters the @threshold@ value,
+-- an @inverse@ flag, and the source 'HIplImage'.
 thresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
                    d -> Bool -> HIplImage a MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
@@ -145,8 +146,8 @@ unsafeThresholdToZero th inv = unsafeCvThreshold1 th 0 tType
 
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
--- thresholded image. Takes the source 'HIplImage' and the @maxValue@
--- to replace pixels that pass the threshold with.
+-- thresholded image. Takes the @maxValue@ to replace pixels that pass
+-- the threshold with and the source 'HIplImage'.
 thresholdBinaryOtsu :: Word8 -> Bool -> HIplImage a MonoChromatic Word8 ->
                        (HIplImage FreshImage MonoChromatic Word8, Word8)
 thresholdBinaryOtsu maxValue inverse = cvThresholdOtsu maxValue tType
@@ -181,8 +182,8 @@ unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged. If @inverse@ is 'True', the
--- operation's meaning is reversed. Takes the source 'HIplImage' and
--- the @inverse@ flag; the @threshold@ value is chosen using Otsu's
+-- operation's meaning is reversed. Takes an @inverse@ flag and the
+-- source 'HIplImage'; the @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
 thresholdToZeroOtsu :: Bool -> HIplImage a MonoChromatic Word8 -> 
                        (HIplImage FreshImage MonoChromatic Word8, Word8)
@@ -197,4 +198,4 @@ unsafeToZeroOtsu f = unsafeCvThresholdOtsu 0 tType
 {-# RULES "thresholdToZeroOtsu-inplace"
   forall f (g :: a -> HIplImage FreshImage MonoChromatic Word8).
   thresholdToZeroOtsu f . g = unsafeToZeroOtsu f . g
-  #-}
\ No newline at end of file
+  #-}
diff --git a/src/AI/CV/OpenCV/Types.hs b/src/AI/CV/OpenCV/Types.hs
deleted file mode 100644
index ca94f2e..0000000
--- a/src/AI/CV/OpenCV/Types.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module AI.CV.OpenCV.Types where
-import AI.CV.OpenCV.CxCore
-import AI.CV.OpenCV.HighGui
-import Foreign.Ptr
-import Foreign.ForeignPtr
-
-type PImage = Ptr IplImage
-type PCapture = Ptr CvCapture
-
-type FPImage = ForeignPtr IplImage
-type FPCapture = ForeignPtr CvCapture

From 0695bf000a41f3650eeb195f54843ff8b425aea0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 Aug 2010 20:45:06 -0400
Subject: [PATCH 045/137] Added CvVideoWriter support.

---
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c |  6 +++++
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h |  1 +
 src/AI/CV/OpenCV/Core/HighGui.hsc    | 40 +++++++++++++++++++++++++---
 src/AI/CV/OpenCV/HighCV.hs           | 22 ++++++++++++---
 4 files changed, 62 insertions(+), 7 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index 1d88946..caa0c7b 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -35,6 +35,12 @@ void release_capture(CvCapture *capture)
     cvReleaseCapture(&temp);
 }
 
+void release_video_writer(CvVideoWriter *writer)
+{
+    CvVideoWriter *temp = writer;
+    cvReleaseVideoWriter(&temp);
+}
+
 /****************************************************************************/
 
 void num_to_name(int num, char *name, int length)
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index b44cc10..484effb 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -4,6 +4,7 @@
 void debug_print_image_header(IplImage *image);
 
 void release_capture(CvCapture *capture);
+void release_video_writer(CvVideoWriter *writer);
 
     
 void new_window(int num, int flags);
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
index 55a8e46..4928a4c 100644
--- a/src/AI/CV/OpenCV/Core/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -6,8 +6,10 @@ module AI.CV.OpenCV.Core.HighGui
      cvCreateFileCapture, setCapturePos, 
      CapturePos(..), cvQueryFrame,
      newWindow, delWindow, showImage, waitKey,
-     cvConvertImage, c_debug_ipl) where
- 
+     cvConvertImage, c_debug_ipl,
+     createVideoWriterF, cvWriteFrame, FourCC) where
+
+import Data.Bits ((.&.), shiftL) 
 import Foreign.ForeignPtrWrap
 import Foreign.C.Types
 import Foreign.Ptr
@@ -107,8 +109,38 @@ foreign import ccall unsafe "highgui.h cvQueryFrame"
 
 cvQueryFrame :: Ptr CvCapture -> IO (Maybe (Ptr IplImage))
 cvQueryFrame cap = ptrToMaybe `fmap` c_cvQueryFrame cap
--- cvQueryFrame cap = errorName "Failed to query frame from capture device" . 
---                    checkPtr $ c_cvQueryFrame cap
+
+data CvVideoWriter
+
+type FourCC = (Char, Char, Char, Char)
+
+fourCC :: FourCC -> CInt
+fourCC (a,b,c,d) = (c1 .&. 255) + shiftL (c2 .&. 255) 8 + 
+                   shiftL (c3 .&. 255) 16 + shiftL (c4 .&. 255) 24
+    where [c1,c2,c3,c4] = map (fromIntegral . fromEnum) [a,b,c,d]
+
+foreign import ccall unsafe "highgui.h cvCreateVideoWriter"
+  c_cvCreateVideoWriter :: CString -> CInt -> CDouble -> CInt -> CInt -> CInt ->
+                           IO (Ptr CvVideoWriter)
+
+foreign import ccall unsafe "HOpenCV_wrap.h &release_video_writer"
+  cp_release_writer :: FunPtr (Ptr CvVideoWriter -> IO ())
+
+cvCreateVideoWriter :: FilePath -> FourCC -> Double -> (Int, Int) -> 
+                       IO (Ptr CvVideoWriter)
+cvCreateVideoWriter fname codec fps (w, h) = 
+    withCString fname $ \str ->
+        c_cvCreateVideoWriter str (fourCC codec) (realToFrac fps) 
+                              (fromIntegral w) (fromIntegral h) 1
+                              
+-- |Create a video file writer.
+createVideoWriterF :: FilePath -> FourCC -> Double -> (Int, Int) -> 
+                      IO (ForeignPtr CvVideoWriter)
+createVideoWriterF fname codec fps sz = createForeignPtr cp_release_writer $
+                                        cvCreateVideoWriter fname codec fps sz
+
+foreign import ccall unsafe "highgui.h cvWriteFrame"
+  cvWriteFrame :: Ptr CvVideoWriter -> Ptr IplImage -> IO ()
 
 -------------------------------------------------
 -- Windows
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index a2dfa72..904a24f 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -9,16 +9,17 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             toFile, fromPtr, isColor, isMono, 
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, cannyEdges, createFileCapture, 
-                            createCameraCapture, resize, 
+                            createCameraCapture, resize, FourCC,
                             InterpolationMethod(..), MonoChromatic, 
-                            TriChromatic, FreshImage,
+                            TriChromatic, FreshImage, createVideoWriter,
                             module AI.CV.OpenCV.ColorConversion)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, 
                                   setCapturePos, CapturePos(PosFrames), 
-                                  CvCapture, createCameraCaptureF)
+                                  CvCapture, createCameraCaptureF, 
+                                  createVideoWriterF, cvWriteFrame, FourCC)
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.ColorConversion
 --import AI.CV.OpenCV.Contours
@@ -254,6 +255,21 @@ createCameraCapture cam = do capture <- createCameraCaptureF cam'
                                      (>>= fromPtr) . queryError)
     where cam' = maybe (-1) id cam
 
+-- |Create a video file writer. The parameters are the file name, the
+-- 4-character code (of the codec used to compress the frames
+-- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
+-- created video stream, and the size of the video frames. The
+-- returned action may be used to add frames to the video stream.
+createVideoWriter :: (HasChannels c, HasDepth d, Storable d) =>
+                     FilePath -> FourCC -> Double -> (Int,Int) -> 
+                     IO (HIplImage a c d -> IO ())
+createVideoWriter fname codec fps sz = 
+    do writer <- createVideoWriterF fname codec fps sz
+       let writeFrame img = withForeignPtr writer $ \writer' ->
+                              withHIplImage img $ \img' ->
+                                cvWriteFrame writer' img'
+       return writeFrame
+
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
 resize :: (HasChannels c, HasDepth d, Storable d) => 

From 35e3950d53b34b634a97c24206bb8c2f440fa592 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 25 Aug 2010 13:21:08 -0400
Subject: [PATCH 046/137] Added type checking for operations that utilize a
 scalar with an image.

Image color and pixel depth types have an associated scalar type synonym,
CvScalar, that can be used with element-wise operations.

- Added cvScaleAdd
- Added cvAndS
- Updated subRS to use the CvScalar associated type.
---
 src/AI/CV/OpenCV/ArrayOps.hs        | 100 ++++++++++++++++------------
 src/AI/CV/OpenCV/Core/HIplImage.hsc |  48 ++++++++++++-
 src/AI/CV/OpenCV/Core/HIplUtils.hs  |   4 +-
 3 files changed, 104 insertions(+), 48 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index bda6d44..515f88d 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables #-}
 -- |Array operations.
-module AI.CV.OpenCV.ArrayOps (subRS, subRSVec, absDiff, convertScale, 
-                              cvAnd, cvAndMask) where
+module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
+                              cvAnd, cvAndMask, cvScaleAdd, cvAndS) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
@@ -15,68 +15,38 @@ foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
-subRS :: (HasDepth d, Storable d) =>
-         d -> HIplImage a MonoChromatic d -> 
-         HIplImage FreshImage MonoChromatic d
+subRS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, 
+          IsCvScalar s, s ~ CvScalar c d) =>
+         s -> HIplImage a c d -> HIplImage FreshImage c d
 subRS value src = unsafePerformIO $ 
                   withHIplImage src $ \srcPtr ->
                     return . fst . withCompatibleImage src $ \dstPtr -> 
-                      c_cvSubRS (castPtr srcPtr) v v v v (castPtr dstPtr) 
+                      c_cvSubRS (castPtr srcPtr) r g b a (castPtr dstPtr) 
                                 nullPtr
-    where v = realToFrac . toDouble $ value
+    where (r,g,b,a) = toCvScalar value
 
 -- Unsafe in-place pointwise subtraction of each pixel from a given
 -- scalar value.
-unsafeSubRS :: (HasDepth d, Storable d) =>
-               d -> HIplImage FreshImage MonoChromatic d ->
-               HIplImage FreshImage MonoChromatic d
+unsafeSubRS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d,
+                IsCvScalar s, s ~ CvScalar c d) =>
+               s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeSubRS value src = unsafePerformIO $
                         withHIplImage src $ \srcPtr ->
-                            do c_cvSubRS (castPtr srcPtr) v v v v 
+                            do c_cvSubRS (castPtr srcPtr) r g b a
                                          (castPtr srcPtr) nullPtr
                                return src
-    where v = realToFrac . toDouble $ value
+    where (r,g,b,a) = toCvScalar value
 
 {-# RULES "subRS-in-place" forall v (f::a -> HIplImage FreshImage MonoChromatic d). 
     subRS v . f = unsafeSubRS v . f
   #-}
 
--- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
-subRSVec :: (HasDepth d, Storable d) =>
-            (d,d,d) -> HIplImage a TriChromatic d ->
-            HIplImage FreshImage TriChromatic d
-subRSVec (r,g,b) src = unsafePerformIO $
-                       withHIplImage src $ \src' ->
-                         return . fst . withCompatibleImage src $ \dst' ->
-                           c_cvSubRS (castPtr src') r' g' b' 0 (castPtr dst')
-                                     nullPtr
-    where r' = realToFrac . toDouble $ r
-          g' = realToFrac . toDouble $ g
-          b' = realToFrac . toDouble $ b
-
-unsafeSubRSVec :: (HasDepth d, Storable d) =>
-                  (d,d,d) -> HIplImage FreshImage TriChromatic d ->
-                  HIplImage FreshImage TriChromatic d
-unsafeSubRSVec (r,g,b) src = unsafePerformIO $
-                             withHIplImage src $ \src' ->
-                                 do c_cvSubRS (castPtr src') r' g' b' 0 
-                                              (castPtr src') nullPtr
-                                    return src
-    where r' = realToFrac . toDouble $ r
-          g' = realToFrac . toDouble $ g
-          b' = realToFrac . toDouble $ b
-
-{-# RULES "subRSVec-inplace" 
-  forall v (g::a->HIplImage FreshImage TriChromatic d).
-  subRSVec v . g = unsafeSubRSVec v . g
-  #-}
-
 foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
 absDiff :: (HasChannels c, HasDepth d, Storable d) => 
-           HIplImage a c d -> HIplImage a c d -> HIplImage FreshImage c d
+           HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
 absDiff src1 src2 = unsafePerformIO $
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
@@ -177,3 +147,45 @@ unsafeAndMask mask src1 src2 = unsafePerformIO $
     forall m s (g :: a -> HIplImage FreshImage c d).
     cvAndMask m s . g = unsafeAndMask m s . g 
   #-}
+
+foreign import ccall unsafe "opencv/cxcore.h cvAndS"
+   c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+               Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Per-element bit-wise conjunction of an array and a scalar. 
+cvAndS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, IsCvScalar s, 
+           s ~ CvScalar c d) => 
+          s -> HIplImage a c d -> HIplImage FreshImage c d
+cvAndS s img = fst . withCompatibleImage img $ \dst ->
+                 withHIplImage img $ \src ->
+                   c_cvAndS (castPtr src) r g b a (castPtr dst) nullPtr
+    where (r,g,b,a) = toCvScalar s
+
+unsafeAndS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, IsCvScalar s, 
+               s ~ CvScalar c d) => 
+              s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+unsafeAndS s img = unsafePerformIO $
+                   do withHIplImage img $ \src ->
+                        c_cvAndS (castPtr src) r g b a (castPtr src) nullPtr
+                      return img
+    where (r,g,b,a) = toCvScalar s
+
+{-# RULES "cvAndS/in-place"
+    forall s (g :: a -> HIplImage FreshImage c d). 
+    cvAndS s . g = unsafeAndS s . g
+  #-}
+
+foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
+  c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+                  Ptr CvArr -> Ptr CvArr -> IO ()
+
+cvScaleAdd :: (HasScalar c d, Storable d, HasDepth d, HasChannels c, 
+               s ~ CvScalar c d, IsCvScalar s) => 
+              HIplImage a c d -> s -> HIplImage b c d -> 
+              HIplImage FreshImage c d
+cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
+                           withHIplImage src1 $ \src1' ->
+                             withHIplImage src2 $ \src2' ->
+                               c_cvScaleAdd (castPtr src1') r g b a 
+                                            (castPtr src2') (castPtr dst)
+    where (r,g,b,a) = toCvScalar s
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 7cf4b61..ba868be 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,8 +1,10 @@
-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, GADTs #-}
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
+             GADTs, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
 module AI.CV.OpenCV.Core.HIplImage 
     ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), width, height, imageData, imageSize, widthStep, 
-      mkHIplImage, withHIplImage, bytesPerPixel, ByteOrFloat) where
+      mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
+      ByteOrFloat, HasScalar(..), IsCvScalar(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
                                  iplDepth32f, iplDepth64f)
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
@@ -88,10 +90,39 @@ class ByteOrFloat a where
 instance ByteOrFloat Word8 where
 instance ByteOrFloat Float where
 
+-- |An image with a particular number of channels have an associated
+-- scalar type built from the type of its pixels. This class lets us
+-- ensure that a scalar value to be used in an operation with an image
+-- is compatible with that image.
+class HasDepth d => HasScalar c d where
+    type CvScalar c d
+
+instance HasDepth d => HasScalar MonoChromatic d where
+    type CvScalar MonoChromatic d = d
+
+instance HasDepth d => HasScalar TriChromatic d where
+    type CvScalar TriChromatic d = (d,d,d)
+
+class IsCvScalar x where
+    toCvScalar :: x -> (CDouble, CDouble, CDouble, CDouble)
+
+instance IsCvScalar Word8 where toCvScalar = depthToScalar
+instance IsCvScalar Word16 where toCvScalar = depthToScalar
+instance IsCvScalar Float where toCvScalar = depthToScalar
+instance IsCvScalar Double where toCvScalar = depthToScalar
+instance (HasDepth d, IsCvScalar d) => IsCvScalar (d,d,d) where
+    toCvScalar (r,g,b) = let f = realToFrac . toDouble
+                         in (f r, f g, f b, 0)
+
+depthToScalar :: HasDepth d => d -> (CDouble, CDouble, CDouble, CDouble)
+depthToScalar x = let x' = realToFrac (toDouble x)
+                  in (x', x', x', x')
+
 bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
     where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
 
+
 -- |A data structure representing the information OpenCV uses from an
 -- 'IplImage' struct. It includes the pixel origin, image width, image
 -- height, image size (number of bytes), a pointer to the pixel data,
@@ -125,6 +156,19 @@ mkHIplImage w h =
           bpp = bytesPerPixel (undefined::d)
           stride = w * (numChannels (undefined::c) :: Int) * bpp
 
+foreign import ccall unsafe "memset"
+  memset :: Ptr Word8 -> Word8 -> CInt -> IO ()
+
+-- |Prepare a 'HIplImage' of the given width and height. Set all
+-- pixels to zero.
+mkBlackImage :: (HasChannels c, HasDepth d, Storable d, Integral a) => 
+                    a -> a -> IO (HIplImage FreshImage c d)
+mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
+                      let sz = fromIntegral $ imageSize img
+                      withForeignPtr (imageData img) $ \ptr ->
+                          memset (castPtr ptr) 0 sz
+                      return img
+
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: (HasChannels c, HasDepth d, Storable d) =>
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 4f3cb30..fabd249 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -6,9 +6,9 @@ module AI.CV.OpenCV.Core.HIplUtils
      compatibleImage, duplicateImage, fromPixels, 
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, 
-     HIplImage, mkHIplImage, width, height, 
+     HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, FreshImage, MonoChromatic, 
-     TriChromatic, HasChannels, HasDepth(..), 
+     TriChromatic, HasChannels, HasDepth(..), HasScalar(..), IsCvScalar(..),
      ByteOrFloat) where
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))

From 6bd4958dd9d7673ce0eb869af013b0515868c762 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 25 Aug 2010 13:57:12 -0400
Subject: [PATCH 047/137] Changed threshold interface to have separate
 functions for inverted thresholds.

---
 src/AI/CV/OpenCV/Threshold.hs | 186 ++++++++++++++++++++++++----------
 1 file changed, 132 insertions(+), 54 deletions(-)

diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 4e1abc7..5f4b661 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -2,9 +2,12 @@
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when composed with a producer of
 -- fresh images.
-module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdTruncate, 
-                               thresholdToZero, thresholdBinaryOtsu, 
-                               thresholdTruncateOtsu, thresholdToZeroOtsu) where
+module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
+                               thresholdTruncate, 
+                               thresholdToZero, thresholdToZeroInv,
+                               thresholdBinaryOtsu, thresholdBinaryOtsuInv,
+                               thresholdTruncateOtsu, 
+                               thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
 import Control.Arrow (second)
 import Data.Bits ((.|.))
 import Data.Word (Word8)
@@ -81,29 +84,47 @@ unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
           tType' = tType .|. otsu
 
 -- |Binary thresholding. Parameters are the @threshold@ value, the
--- @maxValue@ passing pixels are mapped to, an @inverse@ flag, and the
--- source 'HIplImage'. Each pixel is mapped to zero or @maxValue@. If
--- @inverse@ is 'False', then pixels whose value is greater than
--- @threshold@ are mapped to @maxValue@; if @inverse@ is 'True', then
--- pixels whose value is less than or equal to @threshold@ are mapped
--- to @maxValue@.
+-- @maxValue@ passing pixels are mapped to, and the source
+-- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
+-- @maxValue@, while all others are mapped to zero.
 thresholdBinary :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                   d -> d -> Bool -> HIplImage a MonoChromatic d ->
+                   d -> d -> HIplImage a MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
-thresholdBinary th maxValue inverse = cvThreshold1 th maxValue tType
-    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
+
+-- |Inverse binary thresholding. Parameters are the @threshold@ value,
+-- the @maxValue@ passing pixels are mapped to, and the source
+-- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
+-- while all others are mapped to @maxValue@.
+thresholdBinaryInv :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                      d -> d -> HIplImage a MonoChromatic d ->
+                      HIplImage FreshImage MonoChromatic d
+thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
+    where tType = fromEnum ThreshBinaryInv
 
 unsafeThreshBin :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                   d -> d -> Bool -> HIplImage FreshImage MonoChromatic d ->
+                   d -> d -> HIplImage FreshImage MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
-unsafeThreshBin th maxValue inverse = unsafeCvThreshold1 th maxValue tType
-    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
+    where tType = fromEnum ThreshBinary
+
+unsafeThreshBinInv :: (ByteOrFloat d, HasDepth d, Storable d) =>
+                      d -> d -> HIplImage FreshImage MonoChromatic d ->
+                      HIplImage FreshImage MonoChromatic d
+unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
+    where tType = fromEnum ThreshBinaryInv
+
+{-# RULES "thresholdBinary/in-place"
+  forall th mv (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdBinary th mv . g = unsafeThreshBin th mv . g
+  #-}
 
-{-# RULES "thresholdBinary-inplace"
-  forall th mv f (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdBinary th mv f . g = unsafeThreshBin th mv f . g
+{-# RULES "thresholdBinaryInv/in-place"
+  forall th mv (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdBinaryInv th mv . g = unsafeThreshBinInv th mv . g
   #-}
 
+
 -- |Truncation thresholding (i.e. clamping). Parameters are the
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
@@ -118,51 +139,93 @@ unsafeThreshTrunc :: (ByteOrFloat d, HasDepth d, Storable d, Num d) =>
                      HIplImage FreshImage MonoChromatic d
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncate-inplace"
+{-# RULES "thresholdTruncate/in-place"
   forall th (g::a -> HIplImage FreshImage MonoChromatic d).
   thresholdTruncate th . g = unsafeThreshTrunc th . g
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
--- leaves all other pixels unchaged. If @inverse@ is 'True', the
--- operation's meaning is reversed. Parameters the @threshold@ value,
--- an @inverse@ flag, and the source 'HIplImage'.
+-- leaves all other pixels unchanged. Parameters the @threshold@ value
+-- and the source 'HIplImage'.
 thresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                   d -> Bool -> HIplImage a MonoChromatic d ->
+                   d -> HIplImage a MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
-thresholdToZero threshold inverse = cvThreshold1 threshold 0 tType
-    where tType = fromEnum $ if inverse then ThreshToZeroInv else ThreshToZero
+thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
+
+-- |Maps pixels that are greater than @threshold@ to zero; leaves all
+-- other pixels unchanged. Parameters the @threshold@ value and the
+-- source 'HIplImage'.
+thresholdToZeroInv :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                      d -> HIplImage a MonoChromatic d ->
+                      HIplImage FreshImage MonoChromatic d
+thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
+    where tType = fromEnum ThreshToZeroInv
 
 unsafeThresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                         d -> Bool -> HIplImage FreshImage MonoChromatic d ->
+                         d -> HIplImage FreshImage MonoChromatic d ->
                          HIplImage FreshImage MonoChromatic d
-unsafeThresholdToZero th inv = unsafeCvThreshold1 th 0 tType
-    where tType = fromEnum $ if inv then ThreshToZeroInv else ThreshToZero
+unsafeThresholdToZero th = unsafeCvThreshold1 th 0 tType
+    where tType = fromEnum ThreshToZero
 
-{-# RULES "thresholdToZero-inplace" 
-  forall th f (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdToZero th f . g = unsafeThresholdToZero th f . g
+unsafeThresholdToZeroInv :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+                         d -> HIplImage FreshImage MonoChromatic d ->
+                         HIplImage FreshImage MonoChromatic d
+unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
+    where tType = fromEnum ThreshToZeroInv
+
+
+{-# RULES "thresholdToZero/in-place" 
+  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdToZero th . g = unsafeThresholdToZero th . g
   #-}
 
+{-# RULES "thresholdToZeroInv/in-place" 
+  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
+  thresholdToZeroInv th . g = unsafeThresholdToZeroInv th . g
+  #-}
+
+
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'.
-thresholdBinaryOtsu :: Word8 -> Bool -> HIplImage a MonoChromatic Word8 ->
+thresholdBinaryOtsu :: Word8 -> HIplImage a MonoChromatic Word8 ->
                        (HIplImage FreshImage MonoChromatic Word8, Word8)
-thresholdBinaryOtsu maxValue inverse = cvThresholdOtsu maxValue tType
-    where tType = fromEnum $ if inverse then ThreshBinaryInv else ThreshBinary
+thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
+    where tType = fromEnum ThreshBinary
 
-unsafeBinOtsu :: Word8 -> Bool -> HIplImage FreshImage MonoChromatic Word8 ->
+-- |Binary thresholding using Otsu's method to determine an optimal
+-- threshold value. The chosen value is returned along with the
+-- thresholded image. Takes the @maxValue@ to replace pixels that pass
+-- the threshold with and the source 'HIplImage'. The sense of the
+-- thresholding operation is inverted, as in 'thresholdBinaryInv'.
+thresholdBinaryOtsuInv :: Word8 -> HIplImage a MonoChromatic Word8 ->
+                          (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
+    where tType = fromEnum ThreshBinaryInv
+
+unsafeBinOtsu :: Word8 -> HIplImage FreshImage MonoChromatic Word8 ->
                  (HIplImage FreshImage MonoChromatic Word8, Word8)
-unsafeBinOtsu maxValue f = unsafeCvThresholdOtsu maxValue tType
-    where tType = fromEnum $ if f then ThreshBinaryInv else ThreshBinary
+unsafeBinOtsu maxValue = unsafeCvThresholdOtsu maxValue tType
+    where tType = fromEnum ThreshBinary
+
+unsafeBinOtsuInv :: Word8 -> HIplImage FreshImage MonoChromatic Word8 ->
+                    (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
+    where tType = fromEnum ThreshBinaryInv
+
 
-{-# RULES "thresholdBinaryOtsu-inplace"
-  forall mv f (g::a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdBinaryOtsu mv f . g = unsafeBinOtsu mv f . g
+{-# RULES "thresholdBinaryOtsu/in-place"
+  forall mv (g::a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdBinaryOtsu mv . g = unsafeBinOtsu mv . g
   #-}
 
+{-# RULES "thresholdBinaryOtsuInv/in-place"
+  forall mv (g::a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdBinaryOtsuInv mv . g = unsafeBinOtsuInv mv . g
+  #-}
+
+
 -- |Maps pixels that are greater than @threshold@ to the @threshold@
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
@@ -175,27 +238,42 @@ unsafeTruncOtsu :: HIplImage FreshImage MonoChromatic Word8 ->
                    (HIplImage FreshImage MonoChromatic Word8, Word8)
 unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncateOtsu-inplace"
+{-# RULES "thresholdTruncateOtsu/in-place"
   forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
   thresholdTruncateOtsu . g = unsafeTruncOtsu . g
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
--- leaves all other pixels unchaged. If @inverse@ is 'True', the
--- operation's meaning is reversed. Takes an @inverse@ flag and the
--- source 'HIplImage'; the @threshold@ value is chosen using Otsu's
--- method and returned along with the thresholded image.
-thresholdToZeroOtsu :: Bool -> HIplImage a MonoChromatic Word8 -> 
+-- leaves all other pixels unchaged.The @threshold@ value is chosen
+-- using Otsu's method and returned along with the thresholded image.
+thresholdToZeroOtsu :: HIplImage a MonoChromatic Word8 -> 
                        (HIplImage FreshImage MonoChromatic Word8, Word8)
-thresholdToZeroOtsu inverse = cvThresholdOtsu 0 tType
-    where tType = fromEnum $ if inverse then ThreshToZeroInv else ThreshToZero
+thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
 
-unsafeToZeroOtsu :: Bool -> HIplImage FreshImage MonoChromatic Word8 -> 
+-- |Maps pixels that are greather than @threshold@ to zero; leaves all
+-- other pixels unchaged.The @threshold@ value is chosen using Otsu's
+-- method and returned along with the thresholded image.
+thresholdToZeroOtsuInv :: HIplImage a MonoChromatic Word8 -> 
+                          (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
+
+unsafeToZeroOtsu :: HIplImage FreshImage MonoChromatic Word8 -> 
                     (HIplImage FreshImage MonoChromatic Word8, Word8)
-unsafeToZeroOtsu f = unsafeCvThresholdOtsu 0 tType
-    where tType = fromEnum $ if f then ThreshToZeroInv else ThreshToZero
+unsafeToZeroOtsu = unsafeCvThresholdOtsu 0 tType
+    where tType = fromEnum ThreshToZero
+
+unsafeToZeroOtsuInv :: HIplImage FreshImage MonoChromatic Word8 -> 
+                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
+    where tType = fromEnum ThreshToZeroInv
+
 
-{-# RULES "thresholdToZeroOtsu-inplace"
-  forall f (g :: a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdToZeroOtsu f . g = unsafeToZeroOtsu f . g
+{-# RULES "thresholdToZeroOtsu/in-place"
+  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdToZeroOtsu . g = unsafeToZeroOtsu . g
+  #-}
+
+{-# RULES "thresholdToZeroOtsuInv/in-place"
+  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
+  thresholdToZeroOtsuInv . g = unsafeToZeroOtsuInv . g
   #-}

From 52402618207f6bedb915152bb134f1d1f2072d97 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 25 Aug 2010 19:29:21 -0400
Subject: [PATCH 048/137] Added cvMul, cvAdd, and getROI. Allow threshold to
 change pixel type.

The OpenCV threshold operations can return the same pixel type as the
source, or 8-bit pixels. This is now supported and statically checked.
---
 src/AI/CV/OpenCV/ArrayOps.hs       | 103 ++++++++++++++++++++++++++++-
 src/AI/CV/OpenCV/Core/HIplUtils.hs |  32 ++++++++-
 src/AI/CV/OpenCV/HighCV.hs         |   2 +-
 src/AI/CV/OpenCV/Threshold.hs      |  90 +++++++++++++++----------
 4 files changed, 187 insertions(+), 40 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 515f88d..823110f 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables #-}
 -- |Array operations.
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
-                              cvAnd, cvAndMask, cvScaleAdd, cvAndS) where
+                              cvAnd, cvAndMask, cvScaleAdd, cvAndS,
+                              cvMul, cvMul', cvAdd, cvAddS) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
@@ -189,3 +190,103 @@ cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
                                c_cvScaleAdd (castPtr src1') r g b a 
                                             (castPtr src2') (castPtr dst)
     where (r,g,b,a) = toCvScalar s
+
+foreign import ccall unsafe "opencv/cxcore.h cvMul"
+  c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
+
+cvMulAux :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
+cvMulAux src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2) 
+                                   (castPtr dst) (realToFrac s)
+
+-- |Per-element product of two arrays.
+cvMul :: (HasChannels c, HasDepth d, Storable d) => 
+         HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
+cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
+                    withHIplImage src1 $ \src1' ->
+                      withHIplImage src2 $ \src2' ->
+                        cvMulAux src1' src2' dst 1
+
+-- |Per-element product of two arrays with an extra scale factor that
+-- is multiplied with each product.
+cvMul' :: (HasChannels c, HasDepth d, Storable d) => 
+          Double -> HIplImage a c d -> HIplImage b c d -> 
+          HIplImage FreshImage c d
+cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
+                           withHIplImage src1 $ \src1' ->
+                               withHIplImage src2 $ \src2' ->
+                                   cvMulAux src1' src2' dst scale
+
+unsafeMul :: (HasChannels c, HasDepth d, Storable d) => 
+             HIplImage a c d -> HIplImage FreshImage c d -> 
+             HIplImage FreshImage c d
+unsafeMul src1 src2 = unsafePerformIO $
+                      do withHIplImage src1 $ \src1' ->
+                             withHIplImage src2 $ \src2' ->
+                                 cvMulAux src1' src2' src2' 1
+                         return src2
+
+unsafeMul' :: (HasChannels c, HasDepth d, Storable d) => 
+             Double -> HIplImage a c d -> HIplImage FreshImage c d -> 
+             HIplImage FreshImage c d
+unsafeMul' scale src1 src2 = unsafePerformIO $
+                             do withHIplImage src1 $ \src1' ->
+                                  withHIplImage src2 $ \src2' ->
+                                    cvMulAux src1' src2' src2' scale
+                                return src2
+
+
+{-# RULES 
+"cvMul/in-place" forall s1 (g::a->HIplImage FreshImage c d). 
+                     cvMul s1 . g = unsafeMul s1 . g
+"cvMul'/in-place" forall s s1 (g::a->HIplImage FreshImage c d). 
+                      cvMul' s s1 . g = unsafeMul' s s1 . g
+  #-}
+
+foreign import ccall unsafe "opencv/cxcore.h cvAdd"
+  c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Per-element sum of two arrays.
+cvAdd :: (HasChannels c, HasDepth d, Storable d) => 
+         HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
+cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
+                    withHIplImage src1 $ \src1' ->
+                      withHIplImage src2 $ \src2' ->
+                         c_cvAdd (castPtr src1') (castPtr src2') 
+                                 (castPtr dst) nullPtr
+
+unsafeAdd  :: (HasChannels c, HasDepth d, Storable d) => 
+              HIplImage a c d -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+unsafeAdd src1 src2 = unsafePerformIO $
+                      do withHIplImage src1 $ \src1' ->
+                           withHIplImage src2 $ \src2' ->
+                             c_cvAdd (castPtr src1') (castPtr src2') 
+                                     (castPtr src2') nullPtr
+                         return src2
+
+foreign import ccall unsafe "opencv/cxcore.h cvAddS"
+  c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+              Ptr CvArr -> Ptr CvArr -> IO ()
+
+cvAddS :: (HasChannels c, HasDepth d, Storable d, IsCvScalar s, 
+           s ~ CvScalar c d) => 
+          s -> HIplImage a c d -> HIplImage FreshImage c d
+cvAddS scalar src = fst . withCompatibleImage src $ \dst ->
+                      withHIplImage src $ \src' ->
+                        c_cvAddS (castPtr src') r g b a (castPtr dst) nullPtr
+    where (r,g,b,a) = toCvScalar scalar
+
+unsafeAddS :: (HasChannels c, HasDepth d, Storable d, IsCvScalar s, 
+               s ~ CvScalar c d) => 
+              s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+unsafeAddS scalar src = unsafePerformIO $ do
+                        withHIplImage src $ \src' ->
+                          c_cvAddS (castPtr src') r g b a (castPtr src') nullPtr
+                        return src
+    where (r,g,b,a) = toCvScalar scalar
+
+{-# RULES
+"cvAdd/in-place" forall s1 (g::a->HIplImage FreshImage c d). 
+                 cvAdd s1 . g = unsafeAdd s1 . g
+"cvAddS/in-place" forall s (g::a->HIplImage FreshImage c d).
+                  cvAddS s . g = unsafeAddS s . g
+  #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index fabd249..20ca922 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -9,7 +9,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, FreshImage, MonoChromatic, 
      TriChromatic, HasChannels, HasDepth(..), HasScalar(..), IsCvScalar(..),
-     ByteOrFloat) where
+     ByteOrFloat, getROI) where
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
@@ -21,6 +21,7 @@ import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr
 import Foreign.Storable
 import System.Directory (doesFileExist)
+import System.IO.Unsafe
 import Unsafe.Coerce
 
 -- |This is a way to let the type checker know that you belieave an
@@ -41,6 +42,11 @@ isMono = id
 imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
+-- |Return the number of bytes per pixel color component of an
+-- 'HIplImage'.
+colorDepth :: forall a c d. HasDepth d => HIplImage a c d -> Int
+colorDepth _ = bytesPerPixel (undefined::d)
+
 -- |Apply the supplied function to a 'V.Vector' containing the pixels
 -- that make up an 'HIplImage'. This does not copy the underlying
 -- data.
@@ -196,4 +202,26 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
                                 return (img2, r)
-{-# NOINLINE withCompatibleImage #-}
\ No newline at end of file
+{-# NOINLINE withCompatibleImage #-}
+
+-- |Extract a rectangular region of interest from an image. Returns a
+-- new image whose pixel data is copied from the ROI of the source
+-- image. Parameters are the upper-left corner of the ROI in image
+-- coordinates, the (width,height) of the ROI in pixels, and the
+-- source 'HIplImage'.
+getROI :: (HasChannels c, HasDepth d, Storable d) =>
+          (Int,Int) -> (Int,Int) -> HIplImage a c d -> HIplImage FreshImage c d
+getROI (rx,ry) (rw,rh) src = 
+    unsafePerformIO $
+    do img <- mkHIplImage rw rh
+       withForeignPtr (imageData img) $ \dst ->
+         withForeignPtr (imageData src) $ \src ->
+           mapM_ (\(dOff, sOff) -> copyBytes (plusPtr dst dOff) 
+                                             (plusPtr src sOff)
+                                             rowLen)
+                 (zip [0,rowLen..rw*rh*bpp-1] [start,start+stride..])
+       return img
+    where stride = fromIntegral $ widthStep src
+          start = stride*ry + rx*bpp
+          bpp = imgChannels src * colorDepth src
+          rowLen = rw*bpp
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 904a24f..323cf1c 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -9,7 +9,7 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             toFile, fromPtr, isColor, isMono, 
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, cannyEdges, createFileCapture, 
-                            createCameraCapture, resize, FourCC,
+                            createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, FreshImage, createVideoWriter,
                             module AI.CV.OpenCV.ColorConversion)
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 5f4b661..7655c65 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, 
+             MultiParamTypeClasses #-}
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when composed with a producer of
 -- fresh images.
@@ -8,7 +9,6 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdBinaryOtsu, thresholdBinaryOtsuInv,
                                thresholdTruncateOtsu, 
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
-import Control.Arrow (second)
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
@@ -25,34 +25,47 @@ data ThresholdType = ThreshBinary
                    | ThreshToZeroInv
                      deriving Enum
 
+-- The OpenCV thresholding functions have the property that the source
+-- image must be a single-channel with 8-bit or float pixels. The
+-- destination image must be either the same pixel type as the source,
+-- or 8-bit. This means that images of float pixels can be converted
+-- to 8-bit images during the thresholding process.
+class SameOrByte d1 d2 where
+instance SameOrByte Float Word8 where
+instance SameOrByte Float Float where
+instance SameOrByte Word8 Word8 where
+
 foreign import ccall unsafe "opencv/cv.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                    IO (CDouble)
 
 -- The worker function that calls c_cvThreshold.
-cvThreshold :: (ByteOrFloat d, HasDepth d, Storable d) =>
-               d -> d -> Int -> HIplImage a MonoChromatic d ->
-               (HIplImage FreshImage MonoChromatic d, d)
+cvThreshold :: (ByteOrFloat d1, HasDepth d1, Storable d1,
+                HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+               d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
+               (HIplImage FreshImage MonoChromatic d2, d1)
 cvThreshold threshold maxValue tType src = 
     unsafePerformIO $
     withHIplImage src $ \srcPtr ->
-      cvtResult . withCompatibleImage src $ \dstPtr -> 
-                    c_cvThreshold (castPtr srcPtr) (castPtr dstPtr) 
-                                  threshold' maxValue' tType'
+        do dst <- mkHIplImage (width src) (height src)
+           r <- withHIplImage dst $ \dstPtr ->
+                  c_cvThreshold (castPtr srcPtr) (castPtr dstPtr) 
+                                threshold' maxValue' tType'
+           return (dst, fromDouble (realToFrac r))
     where threshold' = realToFrac . toDouble $ threshold
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
-          cvtResult = return . second (fromDouble . realToFrac)
 
-cvThreshold1 :: (ByteOrFloat d, HasDepth d, Storable d) =>
-               d -> d -> Int -> HIplImage a MonoChromatic d ->
-               HIplImage FreshImage MonoChromatic d
+cvThreshold1 :: (ByteOrFloat d1, HasDepth d1, Storable d1, 
+                 HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+               d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
+               HIplImage FreshImage MonoChromatic d2
 cvThreshold1 threshold maxValue tType src = 
     fst $ cvThreshold threshold maxValue tType src
 
-unsafeCvThreshold :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                      d -> d -> Int -> HIplImage FreshImage MonoChromatic d ->
-                      (HIplImage FreshImage MonoChromatic d, d)
+unsafeCvThreshold :: (ByteOrFloat d1, HasDepth d1, Storable d1) =>
+                      d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
+                      (HIplImage FreshImage MonoChromatic d1, d1)
 unsafeCvThreshold threshold maxValue tType src = 
     unsafePerformIO $
     withHIplImage src $ \srcPtr ->
@@ -63,9 +76,9 @@ unsafeCvThreshold threshold maxValue tType src =
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
 
-unsafeCvThreshold1 :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                      d -> d -> Int -> HIplImage FreshImage MonoChromatic d ->
-                      HIplImage FreshImage MonoChromatic d
+unsafeCvThreshold1 :: (ByteOrFloat d1, HasDepth d1, Storable d1) =>
+                      d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
+                      HIplImage FreshImage MonoChromatic d1
 unsafeCvThreshold1 th mv tt = fst . unsafeCvThreshold th mv tt
 
 -- Use Otsu's method to determine an optimal threshold value which is
@@ -87,18 +100,20 @@ unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
 -- @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
-thresholdBinary :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                   d -> d -> HIplImage a MonoChromatic d ->
-                   HIplImage FreshImage MonoChromatic d
+thresholdBinary :: (ByteOrFloat d1, HasDepth d1, Storable d1, 
+                    HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+                   d1 -> d1 -> HIplImage a MonoChromatic d1 ->
+                   HIplImage FreshImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
 -- the @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
-thresholdBinaryInv :: (ByteOrFloat d, HasDepth d, Storable d) =>
-                      d -> d -> HIplImage a MonoChromatic d ->
-                      HIplImage FreshImage MonoChromatic d
+thresholdBinaryInv :: (ByteOrFloat d1, HasDepth d1, Storable d1,
+                       HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+                      d1 -> d1 -> HIplImage a MonoChromatic d1 ->
+                      HIplImage FreshImage MonoChromatic d2
 thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
@@ -129,14 +144,15 @@ unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
-thresholdTruncate :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                     d -> HIplImage a MonoChromatic d ->
-                     HIplImage FreshImage MonoChromatic d
+thresholdTruncate :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
+                      HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+                     d1 -> HIplImage a MonoChromatic d1 ->
+                     HIplImage FreshImage MonoChromatic d2
 thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
 
-unsafeThreshTrunc :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                     d -> HIplImage FreshImage MonoChromatic d ->
-                     HIplImage FreshImage MonoChromatic d
+unsafeThreshTrunc :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1) =>
+                     d1 -> HIplImage FreshImage MonoChromatic d1 ->
+                     HIplImage FreshImage MonoChromatic d1
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
 {-# RULES "thresholdTruncate/in-place"
@@ -147,17 +163,19 @@ unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
-thresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                   d -> HIplImage a MonoChromatic d ->
-                   HIplImage FreshImage MonoChromatic d
+thresholdToZero :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
+                    HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+                   d1 -> HIplImage a MonoChromatic d1 ->
+                   HIplImage FreshImage MonoChromatic d2
 thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
-thresholdToZeroInv :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                      d -> HIplImage a MonoChromatic d ->
-                      HIplImage FreshImage MonoChromatic d
+thresholdToZeroInv :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
+                       HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+                      d1 -> HIplImage a MonoChromatic d1 ->
+                      HIplImage FreshImage MonoChromatic d2
 thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 

From 55e27802dfaa179ab3683367cb7fd4067441568e Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 30 Aug 2010 11:20:13 -0400
Subject: [PATCH 049/137] Compacted class constraints.

- Gave HasDepth Storable and Num constraints.
- Gave ByteOrFloat a HasDepth constraint.
- Gave SameOrByte (Threshold module) HasDepth constraints.

This simplifies a lot of type signatures with the hypothetical
disadvantage of overly restricting the HasDepth type class.

- Changed the senses of withPixels and withImagePixels to be
  more intuitive. withImagePixels now takes a HIplImage, while
  withPixels takes a Vector.

- Changed the HIplImage data type definition to use record syntax.
---
 src/AI/CV/OpenCV/ArrayOps.hs         | 51 ++++++++++-----------
 src/AI/CV/OpenCV/ColorConversion.hs  | 11 +++--
 src/AI/CV/OpenCV/Core/HIplImage.hsc  | 67 ++++++++--------------------
 src/AI/CV/OpenCV/Core/HIplUtils.hs   | 43 ++++++++----------
 src/AI/CV/OpenCV/FeatureDetection.hs |  5 +--
 src/AI/CV/OpenCV/Filtering.hsc       |  7 ++-
 src/AI/CV/OpenCV/HighCV.hs           | 26 +++++------
 src/AI/CV/OpenCV/PixelUtils.hs       | 10 ++---
 src/AI/CV/OpenCV/Threshold.hs        | 47 ++++++++-----------
 9 files changed, 106 insertions(+), 161 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 823110f..dbdf2df 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -6,7 +6,6 @@ module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale,
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
 import AI.CV.OpenCV.Core.HIplUtils
@@ -16,7 +15,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
-subRS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, 
+subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
           IsCvScalar s, s ~ CvScalar c d) =>
          s -> HIplImage a c d -> HIplImage FreshImage c d
 subRS value src = unsafePerformIO $ 
@@ -28,7 +27,7 @@ subRS value src = unsafePerformIO $
 
 -- Unsafe in-place pointwise subtraction of each pixel from a given
 -- scalar value.
-unsafeSubRS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d,
+unsafeSubRS :: (HasChannels c, HasDepth d, HasScalar c d,
                 IsCvScalar s, s ~ CvScalar c d) =>
                s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeSubRS value src = unsafePerformIO $
@@ -46,7 +45,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
-absDiff :: (HasChannels c, HasDepth d, Storable d) => 
+absDiff :: (HasChannels c, HasDepth d) => 
            HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
 absDiff src1 src2 = unsafePerformIO $
                     withHIplImage src1 $ \src1' ->
@@ -55,7 +54,7 @@ absDiff src1 src2 = unsafePerformIO $
                           c_cvAbsDiff (castPtr src1') (castPtr src2') 
                                       (castPtr dst)
 
-unsafeAbsDiff :: (HasChannels c, HasDepth d, Storable d) => 
+unsafeAbsDiff :: (HasChannels c, HasDepth d) => 
                  HIplImage a c d -> HIplImage FreshImage c d -> 
                  HIplImage FreshImage c d
 unsafeAbsDiff src1 src2 = unsafePerformIO $
@@ -80,8 +79,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
 -- the channels of multi-channel arrays are processed
 -- independentally. Parameters are @scale@, @shift@, and the source
 -- 'HIplImage'.
-convertScale :: (HasChannels c, HasDepth d1, HasDepth d2, 
-                 Storable d1, Storable d2) =>
+convertScale :: (HasChannels c, HasDepth d1, HasDepth d2) =>
                 Double -> Double -> HIplImage a c d1 -> 
                 HIplImage FreshImage c d2
 convertScale scale shift src = unsafePerformIO $
@@ -106,7 +104,7 @@ cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
 -- specifies the elements of the result that will be computed via the
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
-cvAndMask :: (HasChannels c, HasDepth d, Storable d) => 
+cvAndMask :: (HasChannels c, HasDepth d) => 
              HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
              HIplImage b c d -> HIplImage FreshImage c d
 cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
@@ -116,14 +114,14 @@ cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
                                    cvAndAux src1' src2' dst mask'
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
-cvAnd :: (HasChannels c, HasDepth d, Storable d) => 
+cvAnd :: (HasChannels c, HasDepth d) => 
           HIplImage a c d -> HIplImage b c d ->  HIplImage FreshImage c d
 cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
                         cvAndAux src1' src2' dst nullPtr
 
-unsafeAnd :: (HasChannels c, HasDepth d, Storable d) => 
+unsafeAnd :: (HasChannels c, HasDepth d) => 
              HIplImage a c d -> HIplImage FreshImage c d ->  
              HIplImage FreshImage c d
 unsafeAnd src1 src2 = unsafePerformIO $
@@ -131,7 +129,7 @@ unsafeAnd src1 src2 = unsafePerformIO $
                         withHIplImage src2 $ \src2' ->
                           cvAndAux src1' src2' src2' nullPtr >> return src2
 
-unsafeAndMask :: (HasChannels c, HasDepth d, Storable d) => 
+unsafeAndMask :: (HasChannels c, HasDepth d) => 
                  HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
                  HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeAndMask mask src1 src2 = unsafePerformIO $
@@ -154,7 +152,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAndS"
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise conjunction of an array and a scalar. 
-cvAndS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, IsCvScalar s, 
+cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
            s ~ CvScalar c d) => 
           s -> HIplImage a c d -> HIplImage FreshImage c d
 cvAndS s img = fst . withCompatibleImage img $ \dst ->
@@ -162,7 +160,7 @@ cvAndS s img = fst . withCompatibleImage img $ \dst ->
                    c_cvAndS (castPtr src) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar s
 
-unsafeAndS :: (HasChannels c, HasDepth d, Storable d, HasScalar c d, IsCvScalar s, 
+unsafeAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
                s ~ CvScalar c d) => 
               s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeAndS s img = unsafePerformIO $
@@ -180,7 +178,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                   Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvScaleAdd :: (HasScalar c d, Storable d, HasDepth d, HasChannels c, 
+cvScaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
                s ~ CvScalar c d, IsCvScalar s) => 
               HIplImage a c d -> s -> HIplImage b c d -> 
               HIplImage FreshImage c d
@@ -199,7 +197,7 @@ cvMulAux src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2)
                                    (castPtr dst) (realToFrac s)
 
 -- |Per-element product of two arrays.
-cvMul :: (HasChannels c, HasDepth d, Storable d) => 
+cvMul :: (HasChannels c, HasDepth d) => 
          HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
 cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
@@ -208,7 +206,7 @@ cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
-cvMul' :: (HasChannels c, HasDepth d, Storable d) => 
+cvMul' :: (HasChannels c, HasDepth d) => 
           Double -> HIplImage a c d -> HIplImage b c d -> 
           HIplImage FreshImage c d
 cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
@@ -216,7 +214,7 @@ cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                                withHIplImage src2 $ \src2' ->
                                    cvMulAux src1' src2' dst scale
 
-unsafeMul :: (HasChannels c, HasDepth d, Storable d) => 
+unsafeMul :: (HasChannels c, HasDepth d) => 
              HIplImage a c d -> HIplImage FreshImage c d -> 
              HIplImage FreshImage c d
 unsafeMul src1 src2 = unsafePerformIO $
@@ -225,16 +223,15 @@ unsafeMul src1 src2 = unsafePerformIO $
                                  cvMulAux src1' src2' src2' 1
                          return src2
 
-unsafeMul' :: (HasChannels c, HasDepth d, Storable d) => 
-             Double -> HIplImage a c d -> HIplImage FreshImage c d -> 
-             HIplImage FreshImage c d
+unsafeMul' :: (HasChannels c, HasDepth d) => 
+              Double -> HIplImage a c d -> HIplImage FreshImage c d -> 
+              HIplImage FreshImage c d
 unsafeMul' scale src1 src2 = unsafePerformIO $
                              do withHIplImage src1 $ \src1' ->
                                   withHIplImage src2 $ \src2' ->
                                     cvMulAux src1' src2' src2' scale
                                 return src2
 
-
 {-# RULES 
 "cvMul/in-place" forall s1 (g::a->HIplImage FreshImage c d). 
                      cvMul s1 . g = unsafeMul s1 . g
@@ -246,7 +243,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum of two arrays.
-cvAdd :: (HasChannels c, HasDepth d, Storable d) => 
+cvAdd :: (HasChannels c, HasDepth d) => 
          HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
 cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
@@ -254,7 +251,7 @@ cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                          c_cvAdd (castPtr src1') (castPtr src2') 
                                  (castPtr dst) nullPtr
 
-unsafeAdd  :: (HasChannels c, HasDepth d, Storable d) => 
+unsafeAdd  :: (HasChannels c, HasDepth d) => 
               HIplImage a c d -> HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeAdd src1 src2 = unsafePerformIO $
                       do withHIplImage src1 $ \src1' ->
@@ -267,16 +264,14 @@ foreign import ccall unsafe "opencv/cxcore.h cvAddS"
   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
               Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvAddS :: (HasChannels c, HasDepth d, Storable d, IsCvScalar s, 
-           s ~ CvScalar c d) => 
+cvAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
           s -> HIplImage a c d -> HIplImage FreshImage c d
 cvAddS scalar src = fst . withCompatibleImage src $ \dst ->
                       withHIplImage src $ \src' ->
                         c_cvAddS (castPtr src') r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar scalar
 
-unsafeAddS :: (HasChannels c, HasDepth d, Storable d, IsCvScalar s, 
-               s ~ CvScalar c d) => 
+unsafeAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
               s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeAddS scalar src = unsafePerformIO $ do
                         withHIplImage src $ \src' ->
@@ -289,4 +284,4 @@ unsafeAddS scalar src = unsafePerformIO $ do
                  cvAdd s1 . g = unsafeAdd s1 . g
 "cvAddS/in-place" forall s (g::a->HIplImage FreshImage c d).
                   cvAddS s . g = unsafeAddS s . g
-  #-}
\ No newline at end of file
+  #-}
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 7570b98..a7d0a8e 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -6,30 +6,29 @@ import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.Core.ColorConversion
 import Control.Monad.ST (runST, unsafeIOToST)
-import Foreign.Storable (Storable)
 
-convertGrayToRGB :: (HasDepth d, Storable d) =>
+convertGrayToRGB :: HasDepth d =>
                     HIplImage a MonoChromatic d -> 
                     HIplImage FreshImage TriChromatic d
 convertGrayToRGB = convertColor cv_GRAY2RGB
 
-convertGrayToBGR :: (HasDepth d, Storable d) =>
+convertGrayToBGR :: HasDepth d =>
                     HIplImage a MonoChromatic d -> 
                     HIplImage FreshImage TriChromatic d
 convertGrayToBGR = convertColor cv_GRAY2BGR
 
-convertBGRToGray :: (HasDepth d, Storable d) =>
+convertBGRToGray :: HasDepth d =>
                     HIplImage a TriChromatic d -> 
                     HIplImage FreshImage MonoChromatic d
 convertBGRToGray = convertColor cv_BGR2GRAY
 
-convertRGBToGray :: (HasDepth d, Storable d) =>
+convertRGBToGray :: HasDepth d =>
                     HIplImage a TriChromatic d -> 
                     HIplImage FreshImage MonoChromatic d
 convertRGBToGray = convertBGRToGray
 
 -- |Convert the color model of an image.
-convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, Storable d) =>
+convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
                 ColorConversion -> HIplImage a c1 d -> HIplImage FreshImage c2 d
 convertColor cc img = runST $ unsafeIOToST $ 
                       withHIplImage img $
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index ba868be..de78e58 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,9 +1,8 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
-             GADTs, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
+             TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs #-}
 module AI.CV.OpenCV.Core.HIplImage 
     ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
-      HIplImage(..), width, height, imageData, imageSize, widthStep, 
-      mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
+      HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
       ByteOrFloat, HasScalar(..), IsCvScalar(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
                                  iplDepth32f, iplDepth64f)
@@ -62,9 +61,9 @@ data MonoChromatic
 class HasChannels a where
     numChannels :: a -> Int
 
-class HasDepth a where
-    depth    :: a -> Depth
-    toDouble :: a -> Double
+class (Storable a, Num a) => HasDepth a where
+    depth      :: a -> Depth
+    toDouble   :: a -> Double
     fromDouble :: Double -> a
 
 instance HasChannels TriChromatic where numChannels _ = 3
@@ -86,7 +85,7 @@ instance HasDepth Double where
     toDouble = id
     fromDouble = id
 
-class ByteOrFloat a where
+class HasDepth a => ByteOrFloat a where
 instance ByteOrFloat Word8 where
 instance ByteOrFloat Float where
 
@@ -130,24 +129,17 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- backing pixel data is fresh (vs shared), the number of color
 -- channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the pixel
 -- depth (e.g. 'Word8', 'Float').
-data HIplImage a c d where
-    HIplImage :: (HasChannels c, HasDepth d, Storable d) => 
-                 Int -> Int -> Int -> Int -> ForeignPtr d -> Int -> 
-                 HIplImage a c d
-
-origin, width, height, imageSize, widthStep :: HIplImage a c d -> Int
-origin (HIplImage o _ _ _ _ _) = o
-width (HIplImage _ w _ _ _ _) = w
-height (HIplImage _ _ h _ _ _) = h
-imageSize (HIplImage _ _ _ s _ _) = s
-widthStep (HIplImage _ _ _ _ _ s) = s
-
-imageData :: HIplImage a c d -> ForeignPtr d
-imageData (HIplImage _ _ _ _ d _) = d
+data HIplImage a c d = (HasChannels c, HasDepth d) => 
+                       HIplImage { origin    :: Int
+                                 , width     :: Int
+                                 , height    :: Int
+                                 , imageSize :: Int
+                                 , imageData :: ForeignPtr d
+                                 , widthStep :: Int }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
-mkHIplImage :: forall c d. (HasChannels c, HasDepth d, Storable d) => 
+mkHIplImage :: forall c d. (HasChannels c, HasDepth d) => 
                Int -> Int -> IO (HIplImage FreshImage c d)
 mkHIplImage w h = 
     do ptr <- mallocForeignPtrArray numBytes
@@ -161,8 +153,8 @@ foreign import ccall unsafe "memset"
 
 -- |Prepare a 'HIplImage' of the given width and height. Set all
 -- pixels to zero.
-mkBlackImage :: (HasChannels c, HasDepth d, Storable d, Integral a) => 
-                    a -> a -> IO (HIplImage FreshImage c d)
+mkBlackImage :: (HasChannels c, HasDepth d, Integral a) => 
+                a -> a -> IO (HIplImage FreshImage c d)
 mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
                       let sz = fromIntegral $ imageSize img
                       withForeignPtr (imageData img) $ \ptr ->
@@ -171,7 +163,7 @@ mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
-withHIplImage :: (HasChannels c, HasDepth d, Storable d) =>
+withHIplImage :: (HasChannels c, HasDepth d) =>
                  HIplImage a c d -> (Ptr IplImage -> IO b) -> IO b
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
@@ -212,29 +204,11 @@ pokeIpl himg ptr hp =
 -- values constructed within the Haskell runtime, on the other hand,
 -- do have their underlying pixel data buffers registered with a
 -- finalizer.
-instance forall a c d. (HasChannels c, HasDepth d, Storable d) => 
+instance forall a c d. (HasChannels c, HasDepth d) => 
     Storable (HIplImage a c d) where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
-    -- poke ptr himg = do
-    --   (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
-    --   (#poke IplImage, ID) ptr (0::Int)
-    --   (#poke IplImage, nChannels) ptr (numChannels himg)
-    --   (#poke IplImage, depth) ptr (unDepth (depth himg))
-    --   (#poke IplImage, dataOrder) ptr (dataOrder himg)
-    --   (#poke IplImage, origin) ptr (origin himg)
-    --   (#poke IplImage, width) ptr (width himg)
-    --   (#poke IplImage, height) ptr (height himg)
-    --   (#poke IplImage, roi) ptr nullPtr
-    --   (#poke IplImage, maskROI) ptr nullPtr
-    --   (#poke IplImage, imageId) ptr nullPtr
-    --   (#poke IplImage, tileInfo) ptr nullPtr
-    --   (#poke IplImage, imageSize) ptr (imageSize himg)
-    --   withForeignPtr (imageData himg) $ \p -> (#poke IplImage, imageData) ptr p
-    --   (#poke IplImage, widthStep) ptr (widthStep himg)
-    --   withForeignPtr (imageDataOrigin himg) $ 
-    --     \p ->(#poke IplImage, imageDataOrigin) ptr p
     peek ptr = do
       numChannels' <- (#peek IplImage, nChannels) ptr :: IO Int
       depth' <- Depth <$> (#peek IplImage, depth) ptr
@@ -258,8 +232,3 @@ instance forall a c d. (HasChannels c, HasDepth d, Storable d) =>
                 widthStep' <- (#peek IplImage, widthStep) ptr
                 return $ HIplImage origin' width' height' imageSize' 
                                    imageData' widthStep'
-
-
-
-
-                    
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 20ca922..edb53a0 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -50,10 +50,9 @@ colorDepth _ = bytesPerPixel (undefined::d)
 -- |Apply the supplied function to a 'V.Vector' containing the pixels
 -- that make up an 'HIplImage'. This does not copy the underlying
 -- data.
-withPixels :: forall a c d r. (HasDepth d, Storable d) => 
-              HIplImage a c d -> (V.Vector d -> r) -> r
-withPixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
-    where n = imageSize img `div` bytesPerPixel (undefined::d)
+withImagePixels :: HasDepth d => HIplImage a c d -> (V.Vector d -> r) -> r
+withImagePixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
+    where n = imageSize img `div` colorDepth img
 
 doST :: IO a -> a
 doST x = runST (unsafeIOToST x)
@@ -69,8 +68,7 @@ pixels img = doST $ do ptr <- mallocForeignPtrBytes len
     where len = imageSize img
 
 -- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: (HasChannels c, HasDepth d, Storable d) => 
-           Ptr IplImage -> IO (HIplImage () c d)
+fromPtr :: (HasChannels c, HasDepth d) => Ptr IplImage -> IO (HIplImage () c d)
 fromPtr = peek . castPtr
 
 -- Ensure that a file exists.
@@ -95,16 +93,14 @@ fromFileGray fileName = do checkFile fileName
                            return $ unsafeCoerce img
 
 -- |Save a 'HIplImage' to the specified file.
-toFile :: (HasChannels c, HasDepth d, Storable d) => 
-          FilePath -> HIplImage a c d -> IO ()
+toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage a c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
-compatibleImage :: forall a c d. 
-                   HIplImage a c d -> IO (HIplImage FreshImage c d)
+compatibleImage :: HIplImage a c d -> IO (HIplImage FreshImage c d)
 compatibleImage img@(HIplImage _ _ _ _ _ _) = 
     do ptr <- mallocForeignPtrArray sz
        return $ HIplImage 0 w h sz ptr stride
@@ -115,8 +111,7 @@ compatibleImage img@(HIplImage _ _ _ _ _ _) =
 
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
-duplicateImage :: forall a c d.
-                  HIplImage a c d -> IO (HIplImage FreshImage c d)
+duplicateImage :: HIplImage a c d -> IO (HIplImage FreshImage c d)
 duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
@@ -130,12 +125,12 @@ duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
 -- |Pass the given function a 'HIplImage' constructed from a width, a
 -- height, and a 'V.Vector' of pixel values. The new 'HIplImage' \'s
 -- pixel data is shared with the supplied 'V.Vector'.
-withImagePixels :: forall a c d r. 
-                   (HasChannels c, Integral a, HasDepth d, Storable d) =>
-                   a -> a -> V.Vector d -> (HIplImage () c d -> r) -> r
-withImagePixels w h pix f = if fromIntegral len == sz
-                            then f $ HIplImage 0 w' h' sz fp (w'*nc)
-                            else error "Length disagreement"
+withPixels :: forall a c d r. 
+              (HasChannels c, Integral a, HasDepth d) =>
+              a -> a -> V.Vector d -> (HIplImage () c d -> r) -> r
+withPixels w h pix f = if fromIntegral len == sz
+                       then f $ HIplImage 0 w' h' sz fp (w'*nc)
+                       else error "Length disagreement"
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -148,7 +143,7 @@ withImagePixels w h pix f = if fromIntegral len == sz
 -- |Construct a fresh 'HIplImage' from a width, a height, and a
 -- 'V.Vector' of pixel values.
 fromPixels :: forall a c d. 
-              (Integral a, HasChannels c, HasDepth d, Storable d) =>
+              (Integral a, HasChannels c, HasDepth d) =>
               a -> a -> V.Vector d -> HIplImage FreshImage c d
 fromPixels w h pix = doST $ do fp <- copyData
                                return $ HIplImage 0 w' h' sz fp (w'*nc)
@@ -168,14 +163,14 @@ fromPixels w h pix = doST $ do fp <- copyData
 -- |Helper function to explicitly type a vector of monochromatic pixel
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
-fromGrayPixels :: (HasDepth d, Storable d, Integral a) => 
+fromGrayPixels :: (HasDepth d, Integral a) => 
                   a -> a -> V.Vector d -> HIplImage FreshImage MonoChromatic d
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of trichromatic pixel
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
-fromColorPixels :: (HasDepth d, Storable d, Integral a) =>
+fromColorPixels :: (HasDepth d, Integral a) =>
                    a -> a -> V.Vector d -> HIplImage FreshImage TriChromatic d
 fromColorPixels w h = isColor . fromPixels w h
 
@@ -183,7 +178,7 @@ fromColorPixels w h = isColor . fromPixels w h
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'. Returns the duplicate 'HIplImage' after
 -- performing the given action along with the result of that action.
-withDuplicateImage :: (HasChannels c, HasDepth d, Storable d) => 
+withDuplicateImage :: (HasChannels c, HasDepth d) => 
                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
                       (HIplImage FreshImage c d, b)
 withDuplicateImage img1 f = runST $ unsafeIOToST $
@@ -195,7 +190,7 @@ withDuplicateImage img1 f = runST $ unsafeIOToST $
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
-withCompatibleImage :: (HasChannels c, HasDepth d, Storable d) => 
+withCompatibleImage :: (HasChannels c, HasDepth d) => 
                        HIplImage a c d -> (Ptr IplImage -> IO b) -> 
                        (HIplImage FreshImage c d, b)
 withCompatibleImage img1 f = runST $ unsafeIOToST $
@@ -209,7 +204,7 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
 -- image. Parameters are the upper-left corner of the ROI in image
 -- coordinates, the (width,height) of the ROI in pixels, and the
 -- source 'HIplImage'.
-getROI :: (HasChannels c, HasDepth d, Storable d) =>
+getROI :: (HasChannels c, HasDepth d) =>
           (Int,Int) -> (Int,Int) -> HIplImage a c d -> HIplImage FreshImage c d
 getROI (rx,ry) (rw,rh) src = 
     unsafePerformIO $
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 13bdd4f..ff61075 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -3,7 +3,6 @@
 module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris') where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
-import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtils
@@ -24,7 +23,7 @@ harris src dst blockSize aperture k =
 -- destination image. The parameters are the @blockSize@ and the
 -- source 'HIplImage'. The Sobel operator used as a preprocessing step
 -- is given an aperture size of 3.
-cornerHarris :: (ByteOrFloat d, HasDepth d, Storable d) => 
+cornerHarris :: ByteOrFloat d => 
                 Int -> HIplImage a MonoChromatic d -> 
                 HIplImage FreshImage MonoChromatic Float
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
@@ -37,7 +36,7 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 -- @aperture@ size to be used by the Sobel operator that is run during
 -- corner evaluation, the value of @k@, and the source
 -- 'HIplImage'.
-cornerHarris' :: (ByteOrFloat d, HasDepth d, Storable d) => 
+cornerHarris' :: ByteOrFloat d => 
                  Int -> Int -> Double -> HIplImage a MonoChromatic d -> 
                  HIplImage FreshImage MonoChromatic Float
 cornerHarris' blockSize aperture k src = 
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 446bd18..2986696 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -3,7 +3,6 @@
 module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian') where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
-import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtils
@@ -32,7 +31,7 @@ cvGaussian = #{const CV_GAUSSIAN}
 -- the kernel size. This function is the same as calling
 -- @smoothGaussian' width Nothing Nothing@. May be performed in-place
 -- under composition.
-smoothGaussian :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+smoothGaussian :: (ByteOrFloat d, HasChannels c) => 
                   Int -> HIplImage a c d -> HIplImage FreshImage c d
 smoothGaussian w = smoothGaussian' w Nothing Nothing
 
@@ -42,7 +41,7 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
 -- calculated from the kernel size), and the source image. May be
 -- performed in-place under composition.
-smoothGaussian' :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+smoothGaussian' :: (ByteOrFloat d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
                    HIplImage FreshImage c d
 smoothGaussian' w h sigma src = 
@@ -53,7 +52,7 @@ smoothGaussian' w h sigma src =
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
           h' = case h of { Nothing -> 0; Just jh -> jh }
 
-unsafeGaussian  :: (ByteOrFloat d, HasDepth d, Storable d, HasChannels c) => 
+unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double ->
                    HIplImage FreshImage c d -> HIplImage FreshImage c d
 unsafeGaussian w h sigma src = unsafePerformIO $ 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 323cf1c..f9b11a7 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -32,7 +32,7 @@ import Unsafe.Coerce
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: (HasChannels c, HasDepth d, Storable d) =>
+erode :: (HasChannels c, HasDepth d) =>
          Int -> HIplImage a c d -> HIplImage FreshImage c d
 erode n img = runST $
               unsafeIOToST . withHIplImage img $
@@ -42,7 +42,7 @@ erode n img = runST $
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: (HasChannels c, HasDepth d, Storable d) =>
+dilate :: (HasChannels c, HasDepth d) =>
           Int -> HIplImage a c d -> HIplImage FreshImage c d
 dilate n img = runST $ 
                unsafeIOToST . withHIplImage img $
@@ -53,7 +53,7 @@ dilate n img = runST $
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the rewrite rules when there is no way to
 -- observe the input image.
-unsafeErode :: (HasChannels c, HasDepth d, Storable d) =>
+unsafeErode :: (HasChannels c, HasDepth d) =>
                Int -> HIplImage a c d -> HIplImage FreshImage c d
 unsafeErode n img = runST $ 
                     unsafeIOToST $
@@ -64,7 +64,7 @@ unsafeErode n img = runST $
 -- |Unsafe in-place dilation. This is a destructive update of the
 -- given image and is only used by the rewrite rules when there is no
 -- way to observe the input image.
-unsafeDilate :: (HasChannels c, HasDepth d, Storable d) =>
+unsafeDilate :: (HasChannels c, HasDepth d) =>
                 Int -> HIplImage a c d-> HIplImage FreshImage c d
 unsafeDilate n img = runST $ 
                      unsafeIOToST $
@@ -87,7 +87,7 @@ unsafeDilate n img = runST $
 -- the end points. Parameters are the two endpoints, the line
 -- connectivity to use when sampling, and an image; returns the list
 -- of pixel values.
-sampleLine :: (HasChannels c, HasDepth d, Storable d) =>
+sampleLine :: (HasChannels c, HasDepth d) =>
               (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage a c d -> [d]
 sampleLine pt1 pt2 conn img = runST $ unsafeIOToST $ 
                               withHIplImage img $ 
@@ -164,7 +164,7 @@ lineTypeEnum AALine    = 16
 -- |Draw each line, defined by its endpoints, on a duplicate of the
 -- given 'HIplImage' using the specified RGB color, line thickness,
 -- and aliasing style.
-drawLines :: (HasChannels c, HasDepth d, Storable d) =>
+drawLines :: (HasChannels c, HasDepth d) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
              HIplImage a c d -> HIplImage FreshImage c d
 drawLines col thick lineType lines img = 
@@ -173,7 +173,7 @@ drawLines col thick lineType lines img =
           lineType' = lineTypeEnum lineType
 
 -- |Unsafe in-place line drawing.
-unsafeDrawLines :: (HasChannels c, HasDepth d, Storable d) =>
+unsafeDrawLines :: (HasChannels c, HasDepth d) =>
                    RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
                    HIplImage a c d -> HIplImage FreshImage c d
 unsafeDrawLines col thick lineType lines img = 
@@ -192,7 +192,7 @@ unsafeDrawLines col thick lineType lines img =
 -- is used for edge linking, the largest value is used to find the
 -- initial segments of strong edges. The third parameter is the
 -- aperture parameter for the Sobel operator.
-cannyEdges :: (HasDepth d, Storable d) =>
+cannyEdges :: HasDepth d =>
               Double -> Double -> Int -> HIplImage a MonoChromatic d -> 
               HIplImage FreshImage MonoChromatic d
 cannyEdges threshold1 threshold2 aperture img = 
@@ -200,7 +200,7 @@ cannyEdges threshold1 threshold2 aperture img =
         withHIplImage img $ \src -> 
             cvCanny src dst threshold1 threshold2 aperture
 
-unsafeCanny :: (HasDepth d, Storable d) =>
+unsafeCanny :: HasDepth d =>
                Double -> Double -> Int -> HIplImage FreshImage MonoChromatic d -> 
                HIplImage FreshImage MonoChromatic d
 unsafeCanny threshold1 threshold2 aperture img = 
@@ -238,7 +238,7 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
 
 -- |Open a capture stream from a movie file. The returned action may
 -- be used to query for the next available frame.
-createFileCapture :: (HasChannels c, HasDepth d, Storable d) =>
+createFileCapture :: (HasChannels c, HasDepth d) =>
                      FilePath -> IO (IO (HIplImage () c d))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ 
@@ -248,7 +248,7 @@ createFileCapture fname = do capture <- createFileCaptureF fname
 -- the index of the camera to be used, or 'Nothing' if it does not
 -- matter what camera is used. The returned action may be used to
 -- query for the next available frame.
-createCameraCapture :: (HasChannels c, HasDepth d, Storable d) =>
+createCameraCapture :: (HasChannels c, HasDepth d) =>
                        Maybe Int -> IO (IO (HIplImage () c d))
 createCameraCapture cam = do capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
@@ -260,7 +260,7 @@ createCameraCapture cam = do capture <- createCameraCaptureF cam'
 -- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
 -- created video stream, and the size of the video frames. The
 -- returned action may be used to add frames to the video stream.
-createVideoWriter :: (HasChannels c, HasDepth d, Storable d) =>
+createVideoWriter :: (HasChannels c, HasDepth d) =>
                      FilePath -> FourCC -> Double -> (Int,Int) -> 
                      IO (HIplImage a c d -> IO ())
 createVideoWriter fname codec fps sz = 
@@ -272,7 +272,7 @@ createVideoWriter fname codec fps sz =
 
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
-resize :: (HasChannels c, HasDepth d, Storable d) => 
+resize :: (HasChannels c, HasDepth d) => 
           InterpolationMethod -> Int -> Int -> HIplImage a c d -> 
           HIplImage FreshImage c d
 resize method w h img = 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 964fa95..b9e0451 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
 -- |Images obtained from OpenCV usually have the components of color
 -- pixels arranged in BGR order and pad image rows with unused
 -- bytes. This module provides mechanisms to drop the unused packing
@@ -8,7 +8,6 @@ import AI.CV.OpenCV.Core.HIplImage
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.ColorConversion (convertRGBToGray)
 import Control.Monad.ST (runST)
-import Data.Vector.Storable (Storable)
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as VM
 import qualified Data.Vector.Generic as VG
@@ -21,7 +20,7 @@ import Unsafe.Coerce (unsafeCoerce)
 -- pixel data that excludes these unused bytes. If the original image
 -- data is already packed, it is returned as a 'V.Vector' without
 -- copying.
-packPixels :: (HasChannels c, HasDepth d, Storable d) => 
+packPixels :: (HasChannels c, HasDepth d) => 
               HIplImage a c d -> V.Vector d
 packPixels img = 
     if w' == stride 
@@ -48,8 +47,7 @@ packPixels img =
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: (HasDepth d, Storable d) => 
-                  Int -> HIplImage a TriChromatic d -> V.Vector d
+isolateChannel :: HasDepth d => Int -> HIplImage a TriChromatic d -> V.Vector d
 isolateChannel ch img = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"
@@ -68,7 +66,7 @@ isolateChannel ch img =
 {-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: forall a c d. (HasChannels c, HasDepth d, Storable d, Integral d) => 
+toMono :: (HasChannels c, HasDepth d, Integral d) => 
           HIplImage a c d -> V.Vector d
 toMono img = if imgChannels img == 1 then packPixels img
              else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 7655c65..621985b 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -13,7 +13,6 @@ import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr)
-import Foreign.Storable (Storable)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtils
@@ -30,7 +29,7 @@ data ThresholdType = ThreshBinary
 -- destination image must be either the same pixel type as the source,
 -- or 8-bit. This means that images of float pixels can be converted
 -- to 8-bit images during the thresholding process.
-class SameOrByte d1 d2 where
+class (HasDepth d1, HasDepth d2) => SameOrByte d1 d2 where
 instance SameOrByte Float Word8 where
 instance SameOrByte Float Float where
 instance SameOrByte Word8 Word8 where
@@ -40,8 +39,7 @@ foreign import ccall unsafe "opencv/cv.h cvThreshold"
                    IO (CDouble)
 
 -- The worker function that calls c_cvThreshold.
-cvThreshold :: (ByteOrFloat d1, HasDepth d1, Storable d1,
-                HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
                (HIplImage FreshImage MonoChromatic d2, d1)
 cvThreshold threshold maxValue tType src = 
@@ -56,16 +54,15 @@ cvThreshold threshold maxValue tType src =
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
 
-cvThreshold1 :: (ByteOrFloat d1, HasDepth d1, Storable d1, 
-                 HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+cvThreshold1 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
                HIplImage FreshImage MonoChromatic d2
 cvThreshold1 threshold maxValue tType src = 
     fst $ cvThreshold threshold maxValue tType src
 
-unsafeCvThreshold :: (ByteOrFloat d1, HasDepth d1, Storable d1) =>
-                      d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
-                      (HIplImage FreshImage MonoChromatic d1, d1)
+unsafeCvThreshold :: ByteOrFloat d1 =>
+                     d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
+                     (HIplImage FreshImage MonoChromatic d1, d1)
 unsafeCvThreshold threshold maxValue tType src = 
     unsafePerformIO $
     withHIplImage src $ \srcPtr ->
@@ -76,7 +73,7 @@ unsafeCvThreshold threshold maxValue tType src =
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
 
-unsafeCvThreshold1 :: (ByteOrFloat d1, HasDepth d1, Storable d1) =>
+unsafeCvThreshold1 :: ByteOrFloat d1 =>
                       d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
                       HIplImage FreshImage MonoChromatic d1
 unsafeCvThreshold1 th mv tt = fst . unsafeCvThreshold th mv tt
@@ -100,8 +97,7 @@ unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
 -- @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
-thresholdBinary :: (ByteOrFloat d1, HasDepth d1, Storable d1, 
-                    HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> d1 -> HIplImage a MonoChromatic d1 ->
                    HIplImage FreshImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
@@ -110,20 +106,19 @@ thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
 -- the @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
-thresholdBinaryInv :: (ByteOrFloat d1, HasDepth d1, Storable d1,
-                       HasDepth d2, Storable d2, SameOrByte d1 d2) =>
+thresholdBinaryInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                       d1 -> d1 -> HIplImage a MonoChromatic d1 ->
                       HIplImage FreshImage MonoChromatic d2
 thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
-unsafeThreshBin :: (ByteOrFloat d, HasDepth d, Storable d) =>
+unsafeThreshBin :: ByteOrFloat d =>
                    d -> d -> HIplImage FreshImage MonoChromatic d ->
                    HIplImage FreshImage MonoChromatic d
 unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinary
 
-unsafeThreshBinInv :: (ByteOrFloat d, HasDepth d, Storable d) =>
+unsafeThreshBinInv :: ByteOrFloat d =>
                       d -> d -> HIplImage FreshImage MonoChromatic d ->
                       HIplImage FreshImage MonoChromatic d
 unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
@@ -144,13 +139,12 @@ unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
-thresholdTruncate :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
-                      HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+thresholdTruncate :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                      d1 -> HIplImage a MonoChromatic d1 ->
                      HIplImage FreshImage MonoChromatic d2
 thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
 
-unsafeThreshTrunc :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1) =>
+unsafeThreshTrunc :: ByteOrFloat d1 =>
                      d1 -> HIplImage FreshImage MonoChromatic d1 ->
                      HIplImage FreshImage MonoChromatic d1
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
@@ -163,8 +157,7 @@ unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
-thresholdToZero :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
-                    HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+thresholdToZero :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                    d1 -> HIplImage a MonoChromatic d1 ->
                    HIplImage FreshImage MonoChromatic d2
 thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
@@ -172,22 +165,21 @@ thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
-thresholdToZeroInv :: (ByteOrFloat d1, HasDepth d1, Storable d1, Num d1,
-                       HasDepth d2, Storable d2, SameOrByte d1 d2) => 
+thresholdToZeroInv :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                       d1 -> HIplImage a MonoChromatic d1 ->
                       HIplImage FreshImage MonoChromatic d2
 thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 
-unsafeThresholdToZero :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
+unsafeThresholdToZero :: ByteOrFloat d => 
                          d -> HIplImage FreshImage MonoChromatic d ->
                          HIplImage FreshImage MonoChromatic d
 unsafeThresholdToZero th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZero
 
-unsafeThresholdToZeroInv :: (ByteOrFloat d, HasDepth d, Storable d, Num d) => 
-                         d -> HIplImage FreshImage MonoChromatic d ->
-                         HIplImage FreshImage MonoChromatic d
+unsafeThresholdToZeroInv :: ByteOrFloat d => 
+                            d -> HIplImage FreshImage MonoChromatic d ->
+                            HIplImage FreshImage MonoChromatic d
 unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZeroInv
 
@@ -285,7 +277,6 @@ unsafeToZeroOtsuInv :: HIplImage FreshImage MonoChromatic Word8 ->
 unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZeroInv
 
-
 {-# RULES "thresholdToZeroOtsu/in-place"
   forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
   thresholdToZeroOtsu . g = unsafeToZeroOtsu . g

From bd36e5f124ef5f8cc842ed34fb2c5626433ac248 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 30 Aug 2010 12:04:46 -0400
Subject: [PATCH 050/137] Normalized to using unsafePerformIO wherever it is
 necessary.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs |  6 ++-
 src/AI/CV/OpenCV/HighCV.hs         | 65 +++++++++++++++++-------------
 2 files changed, 43 insertions(+), 28 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index edb53a0..1fcb42e 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -13,6 +13,7 @@ module AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
+import Control.Monad ((<=<))
 import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8)
@@ -181,7 +182,7 @@ fromColorPixels w h = isColor . fromPixels w h
 withDuplicateImage :: (HasChannels c, HasDepth d) => 
                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
                       (HIplImage FreshImage c d, b)
-withDuplicateImage img1 f = runST $ unsafeIOToST $
+withDuplicateImage img1 f = unsafePerformIO $
                             do img2 <- duplicateImage img1
                                r <- withHIplImage img2 f
                                return (img2, r)
@@ -220,3 +221,6 @@ getROI (rx,ry) (rw,rh) src =
           start = stride*ry + rx*bpp
           bpp = imgChannels src * colorDepth src
           rowLen = rw*bpp
+
+pipeline :: (HIplImage FreshImage c1 d1 -> HIplImage FreshImage c2 d2) -> HIplImage a c1 d1 -> HIplImage FreshImage c2 d2
+pipeline f = unsafePerformIO . (return . f <=< duplicateImage)
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index f9b11a7..31187e3 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -12,7 +12,8 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, FreshImage, createVideoWriter,
-                            module AI.CV.OpenCV.ColorConversion)
+                            module AI.CV.OpenCV.ColorConversion, 
+                            createFileCaptureLoop)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
@@ -23,19 +24,18 @@ import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame,
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.ColorConversion
 --import AI.CV.OpenCV.Contours
-import Control.Monad.ST (runST, unsafeIOToST)
 import Data.Word (Word8)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
+import System.IO.Unsafe (unsafePerformIO)
 import Unsafe.Coerce
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 erode :: (HasChannels c, HasDepth d) =>
          Int -> HIplImage a c d -> HIplImage FreshImage c d
-erode n img = runST $
-              unsafeIOToST . withHIplImage img $
+erode n img = unsafePerformIO . withHIplImage img $
               \src -> return . fst . withCompatibleImage img $
                       \dst -> cvErode src dst n'
     where n' = fromIntegral n
@@ -44,8 +44,7 @@ erode n img = runST $
 -- specified number of iterations.
 dilate :: (HasChannels c, HasDepth d) =>
           Int -> HIplImage a c d -> HIplImage FreshImage c d
-dilate n img = runST $ 
-               unsafeIOToST . withHIplImage img $
+dilate n img = unsafePerformIO . withHIplImage img $
                \src -> return . fst . withCompatibleImage img $
                        \dst -> cvDilate src dst n'
     where n' = fromIntegral n
@@ -55,10 +54,9 @@ dilate n img = runST $
 -- observe the input image.
 unsafeErode :: (HasChannels c, HasDepth d) =>
                Int -> HIplImage a c d -> HIplImage FreshImage c d
-unsafeErode n img = runST $ 
-                    unsafeIOToST $
-                        withHIplImage img (\src -> cvErode src src n') >> 
-                        return (unsafeCoerce img)
+unsafeErode n img = unsafePerformIO $
+                    withHIplImage img (\src -> cvErode src src n') >> 
+                    return (unsafeCoerce img)
     where n' = fromIntegral n
 
 -- |Unsafe in-place dilation. This is a destructive update of the
@@ -66,10 +64,9 @@ unsafeErode n img = runST $
 -- way to observe the input image.
 unsafeDilate :: (HasChannels c, HasDepth d) =>
                 Int -> HIplImage a c d-> HIplImage FreshImage c d
-unsafeDilate n img = runST $ 
-                     unsafeIOToST $
-                         withHIplImage img (\src -> cvDilate src src n') >> 
-                         return (unsafeCoerce img)
+unsafeDilate n img = unsafePerformIO $
+                     withHIplImage img (\src -> cvDilate src src n') >> 
+                     return (unsafeCoerce img)
     where n' = fromIntegral n
 
 -- Perform destructive in-place updates when such a change is
@@ -89,8 +86,7 @@ unsafeDilate n img = runST $
 -- of pixel values.
 sampleLine :: (HasChannels c, HasDepth d) =>
               (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage a c d -> [d]
-sampleLine pt1 pt2 conn img = runST $ unsafeIOToST $ 
-                              withHIplImage img $ 
+sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $ 
                                 \p -> cvSampleLine p pt1 pt2 conn
 
 -- |Line detection in a binary image using a standard Hough
@@ -99,7 +95,7 @@ sampleLine pt1 pt2 conn img = runST $ unsafeIOToST $
 -- line classification accumulator threshold; and the input image.
 houghStandard :: Double -> Double -> Int -> HIplImage a MonoChromatic Word8 -> 
                  [((Int, Int),(Int,Int))]
-houghStandard rho theta threshold img = runST $ unsafeIOToST $
+houghStandard rho theta threshold img = unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        cvSeq <- withHIplImage img $ 
                 \p -> cvHoughLines2 p storage 0 rho theta threshold 0 0
@@ -129,7 +125,7 @@ houghStandard rho theta threshold img = runST $ unsafeIOToST $
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
                       HIplImage a MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
-    runST $ unsafeIOToST $
+    unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
        let cvSeq = snd $ withDuplicateImage img $
                      \p -> cvHoughLines2 p storage 1 rho theta threshold
@@ -177,8 +173,8 @@ unsafeDrawLines :: (HasChannels c, HasDepth d) =>
                    RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
                    HIplImage a c d -> HIplImage FreshImage c d
 unsafeDrawLines col thick lineType lines img = 
-    runST $ unsafeIOToST $
-    withHIplImage img $ \ptr -> mapM_ (draw ptr) lines >> return (unsafeCoerce img)
+    unsafePerformIO . withHIplImage img $ \ptr -> 
+        mapM_ (draw ptr) lines >> return (unsafeCoerce img)
     where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 
@@ -204,8 +200,7 @@ unsafeCanny :: HasDepth d =>
                Double -> Double -> Int -> HIplImage FreshImage MonoChromatic d -> 
                HIplImage FreshImage MonoChromatic d
 unsafeCanny threshold1 threshold2 aperture img = 
-    runST $ unsafeIOToST $
-    withHIplImage img $ \src -> 
+    unsafePerformIO . withHIplImage img $ \src -> 
         cvCanny src src threshold1 threshold2 aperture >> return img
 
 {-# RULES
@@ -237,12 +232,28 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
                           Just f' -> return f'
 
 -- |Open a capture stream from a movie file. The returned action may
--- be used to query for the next available frame.
+-- be used to query for the next available frame. If no frame is
+-- available either due to error or the end of the video sequence,
+-- 'Nothing' is returned.
 createFileCapture :: (HasChannels c, HasDepth d) =>
-                     FilePath -> IO (IO (HIplImage () c d))
+                     FilePath -> IO (IO (Maybe (HIplImage () c d)))
 createFileCapture fname = do capture <- createFileCaptureF fname
-                             return (withForeignPtr capture $ 
-                                     (>>= fromPtr) . queryFrameLoop)
+                             return (withForeignPtr capture $ \cap ->
+                                       do f <- cvQueryFrame cap
+                                          case f of
+                                            Nothing -> return Nothing
+                                            Just f' -> Just `fmap` fromPtr f')
+
+-- |Open a capture stream from a movie file. The returned action may
+-- be used to query for the next available frame. The sequence of
+-- frames will return to its beginning when the end of the video is
+-- encountered.
+createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
+                     FilePath -> IO (IO (HIplImage () c d))
+createFileCaptureLoop fname = do capture <- createFileCaptureF fname
+                                 return (withForeignPtr capture $ 
+                                         (>>= fromPtr) . queryFrameLoop)
+
 
 -- |Open a capture stream from a connected camera. The parameter is
 -- the index of the camera to be used, or 'Nothing' if it does not
@@ -276,7 +287,7 @@ resize :: (HasChannels c, HasDepth d) =>
           InterpolationMethod -> Int -> Int -> HIplImage a c d -> 
           HIplImage FreshImage c d
 resize method w h img = 
-    runST $ unsafeIOToST $
+    unsafePerformIO $
     do img' <- mkHIplImage w h
        _ <- withHIplImage img $ \src ->
               withHIplImage img' $ \dst ->

From abd51da0c9923538667f1a7f8f6310e737acb04b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 30 Aug 2010 18:06:34 -0400
Subject: [PATCH 051/137] Normalized all unsafe rewrites to use the pipeline
 function.

pipeline is a function defined in HIplUtils that passes a
duplicated image to a supplied function. The critical piece
is that pipeline itself has rewrite rules that collapse
compositions of pipelined functions so that the duplication
only occurs at the head of the composite function.

The idea is that the processing functions are typically implemented
by allocating a fresh image into which their results are stored. In
the case where one of the source parameters could serve as a
destination, the processing function creates a compatible image
before writing into it. These functions are referentially transparent
as the allocation is not observable with respect to the semantics of
the program. The unsafe variants do not themselves allocate a
destination image, so, to preserve referential transparency, we must
ensure that the overwritten source image is not observable. This is
accomplished by first wrapping all unsafe operations in a pipeline
call (which creates a duplicate image for the unsafe operation to
clobber), but then fusing composed pipelines to reduce the number
of allocations.
---
 src/AI/CV/OpenCV/ArrayOps.hs         |  86 ++++++--------
 src/AI/CV/OpenCV/ColorConversion.hs  |  14 +--
 src/AI/CV/OpenCV/Core/HIplImage.hsc  |  45 +++----
 src/AI/CV/OpenCV/Core/HIplUtils.hs   |  84 +++++++------
 src/AI/CV/OpenCV/FeatureDetection.hs |   8 +-
 src/AI/CV/OpenCV/Filtering.hsc       |  21 ++--
 src/AI/CV/OpenCV/HighCV.hs           |  60 +++++-----
 src/AI/CV/OpenCV/Motion.hsc          |   8 +-
 src/AI/CV/OpenCV/PixelUtils.hs       |   8 +-
 src/AI/CV/OpenCV/Threshold.hs        | 171 +++++++++++++--------------
 10 files changed, 232 insertions(+), 273 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index dbdf2df..6d036be 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -17,7 +17,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
 -- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
           IsCvScalar s, s ~ CvScalar c d) =>
-         s -> HIplImage a c d -> HIplImage FreshImage c d
+         s -> HIplImage c d -> HIplImage c d
 subRS value src = unsafePerformIO $ 
                   withHIplImage src $ \srcPtr ->
                     return . fst . withCompatibleImage src $ \dstPtr -> 
@@ -29,7 +29,7 @@ subRS value src = unsafePerformIO $
 -- scalar value.
 unsafeSubRS :: (HasChannels c, HasDepth d, HasScalar c d,
                 IsCvScalar s, s ~ CvScalar c d) =>
-               s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+               s -> HIplImage c d -> HIplImage c d
 unsafeSubRS value src = unsafePerformIO $
                         withHIplImage src $ \srcPtr ->
                             do c_cvSubRS (castPtr srcPtr) r g b a
@@ -37,8 +37,7 @@ unsafeSubRS value src = unsafePerformIO $
                                return src
     where (r,g,b,a) = toCvScalar value
 
-{-# RULES "subRS-in-place" forall v (f::a -> HIplImage FreshImage MonoChromatic d). 
-    subRS v . f = unsafeSubRS v . f
+{-# RULES "subRS/in-place" forall v. subRS v = pipeline (unsafeSubRS v)
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
@@ -46,7 +45,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
 
 -- |Calculate the absolute difference between two images.
 absDiff :: (HasChannels c, HasDepth d) => 
-           HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
+           HIplImage c d -> HIplImage c d -> HIplImage c d
 absDiff src1 src2 = unsafePerformIO $
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
@@ -55,8 +54,7 @@ absDiff src1 src2 = unsafePerformIO $
                                       (castPtr dst)
 
 unsafeAbsDiff :: (HasChannels c, HasDepth d) => 
-                 HIplImage a c d -> HIplImage FreshImage c d -> 
-                 HIplImage FreshImage c d
+                 HIplImage c d -> HIplImage c d -> HIplImage c d
 unsafeAbsDiff src1 src2 = unsafePerformIO $
                           withHIplImage src1 $ \src1' ->
                             withHIplImage src2 $ \src2' ->
@@ -64,9 +62,7 @@ unsafeAbsDiff src1 src2 = unsafePerformIO $
                                                (castPtr src2')
                                    return src2
 
-{-# RULES "absDiff-inplace"
-  forall m1 (g::a -> HIplImage FreshImage c d). 
-  absDiff m1 . g = unsafeAbsDiff m1 . g
+{-# RULES "absDiff/in-place" forall m. absDiff m = pipeline (unsafeAbsDiff m) 
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
@@ -80,8 +76,8 @@ foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
 -- independentally. Parameters are @scale@, @shift@, and the source
 -- 'HIplImage'.
 convertScale :: (HasChannels c, HasDepth d1, HasDepth d2) =>
-                Double -> Double -> HIplImage a c d1 -> 
-                HIplImage FreshImage c d2
+                Double -> Double -> HIplImage c d1 -> 
+                HIplImage c d2
 convertScale scale shift src = unsafePerformIO $
                                do dst <- mkHIplImage (width src) (height src)
                                   withHIplImage src $ \src' ->
@@ -105,8 +101,8 @@ cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
 cvAndMask :: (HasChannels c, HasDepth d) => 
-             HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
-             HIplImage b c d -> HIplImage FreshImage c d
+             HIplImage MonoChromatic Word8 -> HIplImage c d ->  
+             HIplImage c d -> HIplImage c d
 cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
                              withHIplImage src1 $ \src1' ->
                                withHIplImage src2 $ \src2' ->
@@ -115,36 +111,31 @@ cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
-          HIplImage a c d -> HIplImage b c d ->  HIplImage FreshImage c d
+          HIplImage c d -> HIplImage c d ->  HIplImage c d
 cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
                         cvAndAux src1' src2' dst nullPtr
 
 unsafeAnd :: (HasChannels c, HasDepth d) => 
-             HIplImage a c d -> HIplImage FreshImage c d ->  
-             HIplImage FreshImage c d
+             HIplImage c d -> HIplImage c d -> HIplImage c d
 unsafeAnd src1 src2 = unsafePerformIO $
                       withHIplImage src1 $ \src1' ->
                         withHIplImage src2 $ \src2' ->
                           cvAndAux src1' src2' src2' nullPtr >> return src2
 
 unsafeAndMask :: (HasChannels c, HasDepth d) => 
-                 HIplImage q MonoChromatic Word8 -> HIplImage a c d ->  
-                 HIplImage FreshImage c d -> HIplImage FreshImage c d
+                 HIplImage MonoChromatic Word8 -> HIplImage c d ->  
+                 HIplImage c d -> HIplImage c d
 unsafeAndMask mask src1 src2 = unsafePerformIO $
                       withHIplImage src1 $ \src1' ->
                         withHIplImage src2 $ \src2' ->
                           withHIplImage mask $ \mask' ->
                             cvAndAux src1' src2' src2' mask' >> return src2
 
-{-# RULES "cvAnd/in-place"
-    forall s (g :: a -> HIplImage FreshImage c d). cvAnd s . g = unsafeAnd s . g
-  #-}
-
-{-# RULES "cvAndMask/in-place"
-    forall m s (g :: a -> HIplImage FreshImage c d).
-    cvAndMask m s . g = unsafeAndMask m s . g 
+{-# RULES 
+"cvAnd/in-place" forall s. cvAnd s = pipeline (unsafeAnd s)
+"cvAndMask/in-place" forall m s. cvAndMask m s = pipeline (unsafeAndMask m s)
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAndS"
@@ -154,7 +145,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAndS"
 -- |Per-element bit-wise conjunction of an array and a scalar. 
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
            s ~ CvScalar c d) => 
-          s -> HIplImage a c d -> HIplImage FreshImage c d
+          s -> HIplImage c d -> HIplImage c d
 cvAndS s img = fst . withCompatibleImage img $ \dst ->
                  withHIplImage img $ \src ->
                    c_cvAndS (castPtr src) r g b a (castPtr dst) nullPtr
@@ -162,17 +153,14 @@ cvAndS s img = fst . withCompatibleImage img $ \dst ->
 
 unsafeAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
                s ~ CvScalar c d) => 
-              s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+              s -> HIplImage c d -> HIplImage c d
 unsafeAndS s img = unsafePerformIO $
                    do withHIplImage img $ \src ->
                         c_cvAndS (castPtr src) r g b a (castPtr src) nullPtr
                       return img
     where (r,g,b,a) = toCvScalar s
 
-{-# RULES "cvAndS/in-place"
-    forall s (g :: a -> HIplImage FreshImage c d). 
-    cvAndS s . g = unsafeAndS s . g
-  #-}
+{-# RULES "cvAndS/in-place" forall s. cvAndS s = pipeline (unsafeAndS s) #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -180,8 +168,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
 
 cvScaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
                s ~ CvScalar c d, IsCvScalar s) => 
-              HIplImage a c d -> s -> HIplImage b c d -> 
-              HIplImage FreshImage c d
+              HIplImage c d -> s -> HIplImage c d -> HIplImage c d
 cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
                            withHIplImage src1 $ \src1' ->
                              withHIplImage src2 $ \src2' ->
@@ -198,7 +185,7 @@ cvMulAux src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2)
 
 -- |Per-element product of two arrays.
 cvMul :: (HasChannels c, HasDepth d) => 
-         HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
+         HIplImage c d -> HIplImage c d -> HIplImage c d
 cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
@@ -207,16 +194,14 @@ cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
 cvMul' :: (HasChannels c, HasDepth d) => 
-          Double -> HIplImage a c d -> HIplImage b c d -> 
-          HIplImage FreshImage c d
+          Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
 cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                            withHIplImage src1 $ \src1' ->
                                withHIplImage src2 $ \src2' ->
                                    cvMulAux src1' src2' dst scale
 
 unsafeMul :: (HasChannels c, HasDepth d) => 
-             HIplImage a c d -> HIplImage FreshImage c d -> 
-             HIplImage FreshImage c d
+             HIplImage c d -> HIplImage c d -> HIplImage c d
 unsafeMul src1 src2 = unsafePerformIO $
                       do withHIplImage src1 $ \src1' ->
                              withHIplImage src2 $ \src2' ->
@@ -224,8 +209,7 @@ unsafeMul src1 src2 = unsafePerformIO $
                          return src2
 
 unsafeMul' :: (HasChannels c, HasDepth d) => 
-              Double -> HIplImage a c d -> HIplImage FreshImage c d -> 
-              HIplImage FreshImage c d
+              Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
 unsafeMul' scale src1 src2 = unsafePerformIO $
                              do withHIplImage src1 $ \src1' ->
                                   withHIplImage src2 $ \src2' ->
@@ -233,10 +217,8 @@ unsafeMul' scale src1 src2 = unsafePerformIO $
                                 return src2
 
 {-# RULES 
-"cvMul/in-place" forall s1 (g::a->HIplImage FreshImage c d). 
-                     cvMul s1 . g = unsafeMul s1 . g
-"cvMul'/in-place" forall s s1 (g::a->HIplImage FreshImage c d). 
-                      cvMul' s s1 . g = unsafeMul' s s1 . g
+"cvMul/in-place" forall s1. cvMul s1 = pipeline (unsafeMul s1)
+"cvMul'/in-place" forall s s1. cvMul' s s1 = pipeline (unsafeMul' s s1)
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAdd"
@@ -244,7 +226,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvAdd"
 
 -- |Per-element sum of two arrays.
 cvAdd :: (HasChannels c, HasDepth d) => 
-         HIplImage a c d -> HIplImage b c d -> HIplImage FreshImage c d
+         HIplImage c d -> HIplImage c d -> HIplImage c d
 cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
@@ -252,7 +234,7 @@ cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                                  (castPtr dst) nullPtr
 
 unsafeAdd  :: (HasChannels c, HasDepth d) => 
-              HIplImage a c d -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+              HIplImage c d -> HIplImage c d -> HIplImage c d
 unsafeAdd src1 src2 = unsafePerformIO $
                       do withHIplImage src1 $ \src1' ->
                            withHIplImage src2 $ \src2' ->
@@ -265,14 +247,14 @@ foreign import ccall unsafe "opencv/cxcore.h cvAddS"
               Ptr CvArr -> Ptr CvArr -> IO ()
 
 cvAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-          s -> HIplImage a c d -> HIplImage FreshImage c d
+          s -> HIplImage c d -> HIplImage c d
 cvAddS scalar src = fst . withCompatibleImage src $ \dst ->
                       withHIplImage src $ \src' ->
                         c_cvAddS (castPtr src') r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar scalar
 
 unsafeAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-              s -> HIplImage FreshImage c d -> HIplImage FreshImage c d
+              s -> HIplImage c d -> HIplImage c d
 unsafeAddS scalar src = unsafePerformIO $ do
                         withHIplImage src $ \src' ->
                           c_cvAddS (castPtr src') r g b a (castPtr src') nullPtr
@@ -280,8 +262,6 @@ unsafeAddS scalar src = unsafePerformIO $ do
     where (r,g,b,a) = toCvScalar scalar
 
 {-# RULES
-"cvAdd/in-place" forall s1 (g::a->HIplImage FreshImage c d). 
-                 cvAdd s1 . g = unsafeAdd s1 . g
-"cvAddS/in-place" forall s (g::a->HIplImage FreshImage c d).
-                  cvAddS s . g = unsafeAddS s . g
+"cvAdd/in-place" forall s. cvAdd s = pipeline (unsafeAdd s)
+"cvAddS/in-place" forall s. cvAddS s = pipeline (unsafeAddS s)
   #-}
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index a7d0a8e..093bbd4 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -8,28 +8,24 @@ import AI.CV.OpenCV.Core.ColorConversion
 import Control.Monad.ST (runST, unsafeIOToST)
 
 convertGrayToRGB :: HasDepth d =>
-                    HIplImage a MonoChromatic d -> 
-                    HIplImage FreshImage TriChromatic d
+                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToRGB = convertColor cv_GRAY2RGB
 
 convertGrayToBGR :: HasDepth d =>
-                    HIplImage a MonoChromatic d -> 
-                    HIplImage FreshImage TriChromatic d
+                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToBGR = convertColor cv_GRAY2BGR
 
 convertBGRToGray :: HasDepth d =>
-                    HIplImage a TriChromatic d -> 
-                    HIplImage FreshImage MonoChromatic d
+                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertBGRToGray = convertColor cv_BGR2GRAY
 
 convertRGBToGray :: HasDepth d =>
-                    HIplImage a TriChromatic d -> 
-                    HIplImage FreshImage MonoChromatic d
+                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertRGBToGray = convertBGRToGray
 
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
-                ColorConversion -> HIplImage a c1 d -> HIplImage FreshImage c2 d
+                ColorConversion -> HIplImage c1 d -> HIplImage c2 d
 convertColor cc img = runST $ unsafeIOToST $ 
                       withHIplImage img $
                         \src -> do dst <- mkHIplImage w h
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index de78e58..a6abad2 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,7 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs #-}
 module AI.CV.OpenCV.Core.HIplImage 
-    ( FreshImage, TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
+    ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
       ByteOrFloat, HasScalar(..), IsCvScalar(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
@@ -49,12 +49,6 @@ typedef struct _IplImage
 IplImage;
 -}
 
--- |Type annotation indicating that an 'HIplImage' is freshly
--- allocated. This is used to drive the allocation fusion mechanism
--- that may perform in-place updates when an operation is composed
--- with a function that returns a fresh image.
-data FreshImage
-
 data TriChromatic
 data MonoChromatic
 
@@ -125,22 +119,21 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- |A data structure representing the information OpenCV uses from an
 -- 'IplImage' struct. It includes the pixel origin, image width, image
 -- height, image size (number of bytes), a pointer to the pixel data,
--- and the row stride. Its type is parameterized by whether or not the
--- backing pixel data is fresh (vs shared), the number of color
--- channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the pixel
--- depth (e.g. 'Word8', 'Float').
-data HIplImage a c d = (HasChannels c, HasDepth d) => 
-                       HIplImage { origin    :: Int
-                                 , width     :: Int
-                                 , height    :: Int
-                                 , imageSize :: Int
-                                 , imageData :: ForeignPtr d
-                                 , widthStep :: Int }
+-- and the row stride. Its type is parameterized by the number of
+-- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
+-- pixel depth (e.g. 'Word8', 'Float').
+data HIplImage c d = (HasChannels c, HasDepth d) => 
+                     HIplImage { origin    :: Int
+                               , width     :: Int
+                               , height    :: Int
+                               , imageSize :: Int
+                               , imageData :: ForeignPtr d
+                               , widthStep :: Int }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
 mkHIplImage :: forall c d. (HasChannels c, HasDepth d) => 
-               Int -> Int -> IO (HIplImage FreshImage c d)
+               Int -> Int -> IO (HIplImage c d)
 mkHIplImage w h = 
     do ptr <- mallocForeignPtrArray numBytes
        return $ HIplImage 0 w h numBytes ptr stride
@@ -154,7 +147,7 @@ foreign import ccall unsafe "memset"
 -- |Prepare a 'HIplImage' of the given width and height. Set all
 -- pixels to zero.
 mkBlackImage :: (HasChannels c, HasDepth d, Integral a) => 
-                a -> a -> IO (HIplImage FreshImage c d)
+                a -> a -> IO (HIplImage c d)
 mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
                       let sz = fromIntegral $ imageSize img
                       withForeignPtr (imageData img) $ \ptr ->
@@ -164,7 +157,7 @@ mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: (HasChannels c, HasDepth d) =>
-                 HIplImage a c d -> (Ptr IplImage -> IO b) -> IO b
+                 HIplImage c d -> (Ptr IplImage -> IO b) -> IO b
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
                                            (\hp -> pokeIpl img p (castPtr hp) >>
@@ -173,8 +166,8 @@ withHIplImage img f = alloca $
 -- Poke a 'Ptr' 'HIplImage' with a specific imageData 'Ptr' that is
 -- currently valid. This is solely an auxiliary function to
 -- 'withHIplImage'.
-pokeIpl :: forall a c d. (HasChannels c, HasDepth d) => 
-           HIplImage a c d -> Ptr (HIplImage a c d) -> Ptr Word8 -> IO ()
+pokeIpl :: forall c d. (HasChannels c, HasDepth d) => 
+           HIplImage c d -> Ptr (HIplImage c d) -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
     do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
        (#poke IplImage, ID) ptr (0::Int)
@@ -204,8 +197,8 @@ pokeIpl himg ptr hp =
 -- values constructed within the Haskell runtime, on the other hand,
 -- do have their underlying pixel data buffers registered with a
 -- finalizer.
-instance forall a c d. (HasChannels c, HasDepth d) => 
-    Storable (HIplImage a c d) where
+instance forall c d. (HasChannels c, HasDepth d) => 
+    Storable (HIplImage c d) where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
@@ -219,7 +212,7 @@ instance forall a c d. (HasChannels c, HasDepth d) =>
                     " but desired HIplImage has depth "++
                     show (depth (undefined::d)))
       if numChannels (undefined::c) /= numChannels'
-        then do img2 <- mkHIplImage width' height' :: IO (HIplImage FreshImage c d)
+        then do img2 <- mkHIplImage width' height' :: IO (HIplImage c d)
                 let conv = if numChannels' == 1 
                            then cv_GRAY2BGR
                            else cv_BGR2GRAY
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 1fcb42e..c778eb3 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -1,14 +1,14 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
 -- |Functions for working with 'HIplImage's.
 module AI.CV.OpenCV.Core.HIplUtils 
     (isColor, isMono, imgChannels, withPixels, pixels,
      fromPtr, fromFileColor, fromFileGray, toFile, 
      compatibleImage, duplicateImage, fromPixels, 
      withImagePixels, fromGrayPixels, fromColorPixels,
-     withDuplicateImage, withCompatibleImage, 
+     withDuplicateImage, withCompatibleImage, pipeline,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
-     withHIplImage, FreshImage, MonoChromatic, 
-     TriChromatic, HasChannels, HasDepth(..), HasScalar(..), IsCvScalar(..),
+     withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
+     HasDepth(..), HasScalar(..), IsCvScalar(..),
      ByteOrFloat, getROI) where
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
@@ -27,12 +27,12 @@ import Unsafe.Coerce
 
 -- |This is a way to let the type checker know that you belieave an
 -- image to be tri-chromatic.
-isColor :: HIplImage a TriChromatic d -> HIplImage a TriChromatic d
+isColor :: HIplImage TriChromatic d -> HIplImage TriChromatic d
 isColor = id
 
 -- |This is a way to let the type checker know that you believe an
 -- image to be monochromatic.
-isMono :: HIplImage a MonoChromatic d -> HIplImage a MonoChromatic d
+isMono :: HIplImage MonoChromatic d -> HIplImage MonoChromatic d
 isMono = id
 
 {-# INLINE isMono #-}
@@ -40,36 +40,34 @@ isMono = id
 
 -- |Return the number of color channels a 'HIplImage' has as a runtime
 -- value.
-imgChannels :: forall a c d. HasChannels c => HIplImage a c d -> Int
+imgChannels :: forall c d. HasChannels c => HIplImage c d -> Int
 imgChannels _ = numChannels (undefined::c)
 
 -- |Return the number of bytes per pixel color component of an
 -- 'HIplImage'.
-colorDepth :: forall a c d. HasDepth d => HIplImage a c d -> Int
+colorDepth :: forall c d. HasDepth d => HIplImage c d -> Int
 colorDepth _ = bytesPerPixel (undefined::d)
 
 -- |Apply the supplied function to a 'V.Vector' containing the pixels
 -- that make up an 'HIplImage'. This does not copy the underlying
 -- data.
-withImagePixels :: HasDepth d => HIplImage a c d -> (V.Vector d -> r) -> r
+withImagePixels :: HasDepth d => HIplImage c d -> (V.Vector d -> r) -> r
 withImagePixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
     where n = imageSize img `div` colorDepth img
 
-doST :: IO a -> a
-doST x = runST (unsafeIOToST x)
-
 -- |Return a 'V.Vector' containing a copy of the pixels that make up a
 -- 'HIplImage'.
-pixels :: Storable d => HIplImage a c d -> V.Vector d
-pixels img = doST $ do ptr <- mallocForeignPtrBytes len
-                       withForeignPtr ptr $ \dst -> 
-                         withForeignPtr (imageData img) $ \src -> 
-                             copyBytes dst src len
-                       return $ V.unsafeFromForeignPtr ptr 0 len
+pixels :: Storable d => HIplImage c d -> V.Vector d
+pixels img = unsafePerformIO $ 
+             do ptr <- mallocForeignPtrBytes len
+                withForeignPtr ptr $ \dst -> 
+                    withForeignPtr (imageData img) $ \src -> 
+                        copyBytes dst src len
+                return $ V.unsafeFromForeignPtr ptr 0 len
     where len = imageSize img
 
 -- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: (HasChannels c, HasDepth d) => Ptr IplImage -> IO (HIplImage () c d)
+fromPtr :: (HasChannels c, HasDepth d) => Ptr IplImage -> IO (HIplImage c d)
 fromPtr = peek . castPtr
 
 -- Ensure that a file exists.
@@ -79,29 +77,29 @@ checkFile f = do e <- doesFileExist f
 
 -- |Load a color 'HIplImage' from an 8-bit image file. If the image
 -- file is grayscale, it will be converted to color.
-fromFileColor :: FilePath -> IO (HIplImage FreshImage TriChromatic Word8)
+fromFileColor :: FilePath -> IO (HIplImage TriChromatic Word8)
 fromFileColor fileName = do checkFile fileName
                             ptr <- cvLoadImage fileName LoadColor
-                            img <- fromPtr ptr :: IO (HIplImage () TriChromatic Word8)
+                            img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8)
                             return $ unsafeCoerce img
 
 -- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
 -- image file is color, it will be converted to grayscale.
-fromFileGray :: FilePath -> IO (HIplImage FreshImage MonoChromatic Word8)
+fromFileGray :: FilePath -> IO (HIplImage MonoChromatic Word8)
 fromFileGray fileName = do checkFile fileName
                            ptr <- cvLoadImage fileName LoadGray
-                           img <- fromPtr ptr :: IO (HIplImage () MonoChromatic Word8)
+                           img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8)
                            return $ unsafeCoerce img
 
 -- |Save a 'HIplImage' to the specified file.
-toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage a c d -> IO ()
+toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
-compatibleImage :: HIplImage a c d -> IO (HIplImage FreshImage c d)
+compatibleImage :: HIplImage c d -> IO (HIplImage c d)
 compatibleImage img@(HIplImage _ _ _ _ _ _) = 
     do ptr <- mallocForeignPtrArray sz
        return $ HIplImage 0 w h sz ptr stride
@@ -112,7 +110,7 @@ compatibleImage img@(HIplImage _ _ _ _ _ _) =
 
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
-duplicateImage :: HIplImage a c d -> IO (HIplImage FreshImage c d)
+duplicateImage :: HIplImage c d -> IO (HIplImage c d)
 duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
@@ -128,7 +126,7 @@ duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
 -- pixel data is shared with the supplied 'V.Vector'.
 withPixels :: forall a c d r. 
               (HasChannels c, Integral a, HasDepth d) =>
-              a -> a -> V.Vector d -> (HIplImage () c d -> r) -> r
+              a -> a -> V.Vector d -> (HIplImage c d -> r) -> r
 withPixels w h pix f = if fromIntegral len == sz
                        then f $ HIplImage 0 w' h' sz fp (w'*nc)
                        else error "Length disagreement"
@@ -145,9 +143,10 @@ withPixels w h pix f = if fromIntegral len == sz
 -- 'V.Vector' of pixel values.
 fromPixels :: forall a c d. 
               (Integral a, HasChannels c, HasDepth d) =>
-              a -> a -> V.Vector d -> HIplImage FreshImage c d
-fromPixels w h pix = doST $ do fp <- copyData
-                               return $ HIplImage 0 w' h' sz fp (w'*nc)
+              a -> a -> V.Vector d -> HIplImage c d
+fromPixels w h pix = unsafePerformIO $ 
+                     do fp <- copyData
+                        return $ HIplImage 0 w' h' sz fp (w'*nc)
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -165,14 +164,14 @@ fromPixels w h pix = doST $ do fp <- copyData
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
 fromGrayPixels :: (HasDepth d, Integral a) => 
-                  a -> a -> V.Vector d -> HIplImage FreshImage MonoChromatic d
+                  a -> a -> V.Vector d -> HIplImage MonoChromatic d
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of trichromatic pixel
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
 fromColorPixels :: (HasDepth d, Integral a) =>
-                   a -> a -> V.Vector d -> HIplImage FreshImage TriChromatic d
+                   a -> a -> V.Vector d -> HIplImage TriChromatic d
 fromColorPixels w h = isColor . fromPixels w h
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
@@ -180,8 +179,8 @@ fromColorPixels w h = isColor . fromPixels w h
 -- given 'HIplImage'. Returns the duplicate 'HIplImage' after
 -- performing the given action along with the result of that action.
 withDuplicateImage :: (HasChannels c, HasDepth d) => 
-                      HIplImage a c d -> (Ptr IplImage -> IO b) -> 
-                      (HIplImage FreshImage c d, b)
+                      HIplImage c d -> (Ptr IplImage -> IO b) -> 
+                      (HIplImage c d, b)
 withDuplicateImage img1 f = unsafePerformIO $
                             do img2 <- duplicateImage img1
                                r <- withHIplImage img2 f
@@ -192,8 +191,8 @@ withDuplicateImage img1 f = unsafePerformIO $
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
 withCompatibleImage :: (HasChannels c, HasDepth d) => 
-                       HIplImage a c d -> (Ptr IplImage -> IO b) -> 
-                       (HIplImage FreshImage c d, b)
+                       HIplImage c d -> (Ptr IplImage -> IO b) -> 
+                       (HIplImage c d, b)
 withCompatibleImage img1 f = runST $ unsafeIOToST $
                              do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
@@ -206,7 +205,7 @@ withCompatibleImage img1 f = runST $ unsafeIOToST $
 -- coordinates, the (width,height) of the ROI in pixels, and the
 -- source 'HIplImage'.
 getROI :: (HasChannels c, HasDepth d) =>
-          (Int,Int) -> (Int,Int) -> HIplImage a c d -> HIplImage FreshImage c d
+          (Int,Int) -> (Int,Int) -> HIplImage c d -> HIplImage c d
 getROI (rx,ry) (rw,rh) src = 
     unsafePerformIO $
     do img <- mkHIplImage rw rh
@@ -222,5 +221,12 @@ getROI (rx,ry) (rw,rh) src =
           bpp = imgChannels src * colorDepth src
           rowLen = rw*bpp
 
-pipeline :: (HIplImage FreshImage c1 d1 -> HIplImage FreshImage c2 d2) -> HIplImage a c1 d1 -> HIplImage FreshImage c2 d2
-pipeline f = unsafePerformIO . (return . f <=< duplicateImage)
\ No newline at end of file
+pipeline :: (HIplImage c d -> r) -> HIplImage c d -> r
+pipeline f = unsafePerformIO . (return . (f $!) <=< duplicateImage)
+
+{-# NOINLINE pipeline #-}
+
+{-# RULES
+"pipeline/join" forall f g h. pipeline f (pipeline g h) = pipeline (f . g) h
+"pipeline/compose" forall f g. pipeline f . pipeline g = pipeline (f. g)
+  #-}
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index ff61075..2c28531 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -24,8 +24,8 @@ harris src dst blockSize aperture k =
 -- source 'HIplImage'. The Sobel operator used as a preprocessing step
 -- is given an aperture size of 3.
 cornerHarris :: ByteOrFloat d => 
-                Int -> HIplImage a MonoChromatic d -> 
-                HIplImage FreshImage MonoChromatic Float
+                Int -> HIplImage MonoChromatic d -> 
+                HIplImage MonoChromatic Float
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 
 -- |Harris corner detector. For each pixel, a 2x2 covariance matrix,
@@ -37,8 +37,8 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 -- corner evaluation, the value of @k@, and the source
 -- 'HIplImage'.
 cornerHarris' :: ByteOrFloat d => 
-                 Int -> Int -> Double -> HIplImage a MonoChromatic d -> 
-                 HIplImage FreshImage MonoChromatic Float
+                 Int -> Int -> Double -> HIplImage MonoChromatic d -> 
+                 HIplImage MonoChromatic Float
 cornerHarris' blockSize aperture k src = 
     unsafePerformIO $ do dst <- mkHIplImage (width src) (height src)
                          withHIplImage src $ \src' ->
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 2986696..5137ed1 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -32,7 +32,7 @@ cvGaussian = #{const CV_GAUSSIAN}
 -- @smoothGaussian' width Nothing Nothing@. May be performed in-place
 -- under composition.
 smoothGaussian :: (ByteOrFloat d, HasChannels c) => 
-                  Int -> HIplImage a c d -> HIplImage FreshImage c d
+                  Int -> HIplImage c d -> HIplImage c d
 smoothGaussian w = smoothGaussian' w Nothing Nothing
 
 -- |Smooth a source 'HIplImage' using a linear convolution with a
@@ -42,8 +42,8 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 -- calculated from the kernel size), and the source image. May be
 -- performed in-place under composition.
 smoothGaussian' :: (ByteOrFloat d, HasChannels c) => 
-                   Int -> Maybe Int -> Maybe Double -> HIplImage a c d -> 
-                   HIplImage FreshImage c d
+                   Int -> Maybe Int -> Maybe Double -> HIplImage c d -> 
+                   HIplImage c d
 smoothGaussian' w h sigma src = 
     unsafePerformIO $
     withHIplImage src $ \src' ->
@@ -54,7 +54,7 @@ smoothGaussian' w h sigma src =
 
 unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double ->
-                   HIplImage FreshImage c d -> HIplImage FreshImage c d
+                   HIplImage c d -> HIplImage c d
 unsafeGaussian w h sigma src = unsafePerformIO $ 
                                withHIplImage src $ \src' ->
                                  do smooth src' src' cvGaussian w h' sigma' 0
@@ -64,12 +64,9 @@ unsafeGaussian w h sigma src = unsafePerformIO $
                      Just s -> realToFrac s
           h' = case h of { Nothing -> 0; Just jh -> jh }
 
-{-# RULES "smoothGaussian'/in-place"
-    forall w h sigma (g::a->HIplImage FreshImage c d). 
-    smoothGaussian' w h sigma . g = unsafeGaussian w h sigma . g 
-  #-}
-
-{-# RULES "smoothGaussian/in-place"
-    forall w (g::a->HIplImage FreshImage c d).
-    smoothGaussian w . g = unsafeGaussian w Nothing Nothing . g
+{-# RULES 
+"smoothGaussian'/in-place" forall w h sigma. 
+  smoothGaussian' w h sigma = pipeline (unsafeGaussian w h sigma)
+"smoothGaussian/in-place" forall w. 
+  smoothGaussian w = pipeline (unsafeGaussian w Nothing Nothing)
   #-}
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 31187e3..a981b5b 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,12 +6,12 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             LineType(..), RGB, drawLines, HIplImage, width, 
                             height, pixels, withPixels, fromGrayPixels, 
                             fromColorPixels, fromFileGray, fromFileColor, 
-                            toFile, fromPtr, isColor, isMono, 
+                            toFile, fromPtr, isColor, isMono, HasDepth, 
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, cannyEdges, createFileCapture, 
                             createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
-                            TriChromatic, FreshImage, createVideoWriter,
+                            TriChromatic, createVideoWriter, HasChannels,
                             module AI.CV.OpenCV.ColorConversion, 
                             createFileCaptureLoop)
     where
@@ -34,7 +34,7 @@ import Unsafe.Coerce
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 erode :: (HasChannels c, HasDepth d) =>
-         Int -> HIplImage a c d -> HIplImage FreshImage c d
+         Int -> HIplImage c d -> HIplImage c d
 erode n img = unsafePerformIO . withHIplImage img $
               \src -> return . fst . withCompatibleImage img $
                       \dst -> cvErode src dst n'
@@ -43,7 +43,7 @@ erode n img = unsafePerformIO . withHIplImage img $
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 dilate :: (HasChannels c, HasDepth d) =>
-          Int -> HIplImage a c d -> HIplImage FreshImage c d
+          Int -> HIplImage c d -> HIplImage c d
 dilate n img = unsafePerformIO . withHIplImage img $
                \src -> return . fst . withCompatibleImage img $
                        \dst -> cvDilate src dst n'
@@ -52,8 +52,8 @@ dilate n img = unsafePerformIO . withHIplImage img $
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the rewrite rules when there is no way to
 -- observe the input image.
-unsafeErode :: (HasChannels c, HasDepth d) =>
-               Int -> HIplImage a c d -> HIplImage FreshImage c d
+unsafeErode :: (HasChannels c, HasDepth d) => 
+               Int -> HIplImage c d -> HIplImage c d
 unsafeErode n img = unsafePerformIO $
                     withHIplImage img (\src -> cvErode src src n') >> 
                     return (unsafeCoerce img)
@@ -63,7 +63,7 @@ unsafeErode n img = unsafePerformIO $
 -- given image and is only used by the rewrite rules when there is no
 -- way to observe the input image.
 unsafeDilate :: (HasChannels c, HasDepth d) =>
-                Int -> HIplImage a c d-> HIplImage FreshImage c d
+                Int -> HIplImage c d-> HIplImage c d
 unsafeDilate n img = unsafePerformIO $
                      withHIplImage img (\src -> cvDilate src src n') >> 
                      return (unsafeCoerce img)
@@ -76,8 +76,8 @@ unsafeDilate n img = unsafePerformIO $
 -- operations are known to be safe.
 
 {-# RULES 
-"erode-in-place"  forall n (f::a -> HIplImage FreshImage c d). erode n . f = unsafeErode n . f
-"dilate-in-place" forall n (f::a -> HIplImage FreshImage c d). dilate n . f = unsafeDilate n . f
+"erode/in-place"  forall n. erode n = pipeline (unsafeErode n)
+"dilate/in-place" forall n. dilate n = pipeline (unsafeDilate n)
   #-}
 
 -- |Extract all the pixel values from an image along a line, including
@@ -85,7 +85,7 @@ unsafeDilate n img = unsafePerformIO $
 -- connectivity to use when sampling, and an image; returns the list
 -- of pixel values.
 sampleLine :: (HasChannels c, HasDepth d) =>
-              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage a c d -> [d]
+              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage c d -> [d]
 sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $ 
                                 \p -> cvSampleLine p pt1 pt2 conn
 
@@ -93,7 +93,7 @@ sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $
 -- transform. Parameters are @rho@, the distance resolution in
 -- pixels; @theta@, the angle resolution in radians; @threshold@, the
 -- line classification accumulator threshold; and the input image.
-houghStandard :: Double -> Double -> Int -> HIplImage a MonoChromatic Word8 -> 
+houghStandard :: Double -> Double -> Int -> HIplImage MonoChromatic Word8 -> 
                  [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -123,7 +123,7 @@ houghStandard rho theta threshold img = unsafePerformIO $
 -- @theta@, the angle resolution in radians; @threshold@, the line
 -- classification accumulator threshold; and the input image.
 houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage a MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
+                      HIplImage MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -162,7 +162,7 @@ lineTypeEnum AALine    = 16
 -- and aliasing style.
 drawLines :: (HasChannels c, HasDepth d) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-             HIplImage a c d -> HIplImage FreshImage c d
+             HIplImage c d -> HIplImage c d
 drawLines col thick lineType lines img = 
     fst $ withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
@@ -171,16 +171,15 @@ drawLines col thick lineType lines img =
 -- |Unsafe in-place line drawing.
 unsafeDrawLines :: (HasChannels c, HasDepth d) =>
                    RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-                   HIplImage a c d -> HIplImage FreshImage c d
+                   HIplImage c d -> HIplImage c d
 unsafeDrawLines col thick lineType lines img = 
     unsafePerformIO . withHIplImage img $ \ptr -> 
         mapM_ (draw ptr) lines >> return (unsafeCoerce img)
     where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 
-{-# RULES
-  "draw-lines-in-place" forall c t lt lns (f::a -> HIplImage FreshImage c d). 
-  drawLines c t lt lns . f = unsafeDrawLines c t lt lns . f
+{-# RULES "drawLines/in-place" forall c t lt lns. 
+  drawLines c t lt lns = pipeline (unsafeDrawLines c t lt lns)
   #-}
 
 -- |Find edges using the Canny algorithm. The smallest value between
@@ -189,24 +188,22 @@ unsafeDrawLines col thick lineType lines img =
 -- initial segments of strong edges. The third parameter is the
 -- aperture parameter for the Sobel operator.
 cannyEdges :: HasDepth d =>
-              Double -> Double -> Int -> HIplImage a MonoChromatic d -> 
-              HIplImage FreshImage MonoChromatic d
+              Double -> Double -> Int -> HIplImage MonoChromatic d -> 
+              HIplImage MonoChromatic d
 cannyEdges threshold1 threshold2 aperture img = 
     fst . withCompatibleImage img $ \dst -> 
         withHIplImage img $ \src -> 
             cvCanny src dst threshold1 threshold2 aperture
 
 unsafeCanny :: HasDepth d =>
-               Double -> Double -> Int -> HIplImage FreshImage MonoChromatic d -> 
-               HIplImage FreshImage MonoChromatic d
+               Double -> Double -> Int -> HIplImage MonoChromatic d -> 
+               HIplImage MonoChromatic d
 unsafeCanny threshold1 threshold2 aperture img = 
     unsafePerformIO . withHIplImage img $ \src -> 
         cvCanny src src threshold1 threshold2 aperture >> return img
 
-{-# RULES
-    "canny-in-place" 
-    forall t1 t2 a (g::a->HIplImage FreshImage MonoChromatic d).
-    cannyEdges t1 t2 a . g = unsafeCanny t1 t2 a . g
+{-# RULES "canny/in-place" forall t1 t2 a.
+  cannyEdges t1 t2 a = pipeline (unsafeCanny t1 t2 a)
   #-}
 
 {-
@@ -235,8 +232,8 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
 -- be used to query for the next available frame. If no frame is
 -- available either due to error or the end of the video sequence,
 -- 'Nothing' is returned.
-createFileCapture :: (HasChannels c, HasDepth d) =>
-                     FilePath -> IO (IO (Maybe (HIplImage () c d)))
+createFileCapture :: (HasChannels c, HasDepth d) => 
+                     FilePath -> IO (IO (Maybe (HIplImage c d)))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ \cap ->
                                        do f <- cvQueryFrame cap
@@ -249,7 +246,7 @@ createFileCapture fname = do capture <- createFileCaptureF fname
 -- frames will return to its beginning when the end of the video is
 -- encountered.
 createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
-                     FilePath -> IO (IO (HIplImage () c d))
+                         FilePath -> IO (IO (HIplImage c d))
 createFileCaptureLoop fname = do capture <- createFileCaptureF fname
                                  return (withForeignPtr capture $ 
                                          (>>= fromPtr) . queryFrameLoop)
@@ -260,7 +257,7 @@ createFileCaptureLoop fname = do capture <- createFileCaptureF fname
 -- matter what camera is used. The returned action may be used to
 -- query for the next available frame.
 createCameraCapture :: (HasChannels c, HasDepth d) =>
-                       Maybe Int -> IO (IO (HIplImage () c d))
+                       Maybe Int -> IO (IO (HIplImage c d))
 createCameraCapture cam = do capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
                                      (>>= fromPtr) . queryError)
@@ -273,7 +270,7 @@ createCameraCapture cam = do capture <- createCameraCaptureF cam'
 -- returned action may be used to add frames to the video stream.
 createVideoWriter :: (HasChannels c, HasDepth d) =>
                      FilePath -> FourCC -> Double -> (Int,Int) -> 
-                     IO (HIplImage a c d -> IO ())
+                     IO (HIplImage c d -> IO ())
 createVideoWriter fname codec fps sz = 
     do writer <- createVideoWriterF fname codec fps sz
        let writeFrame img = withForeignPtr writer $ \writer' ->
@@ -284,8 +281,7 @@ createVideoWriter fname codec fps sz =
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
 resize :: (HasChannels c, HasDepth d) => 
-          InterpolationMethod -> Int -> Int -> HIplImage a c d -> 
-          HIplImage FreshImage c d
+          InterpolationMethod -> Int -> Int -> HIplImage c d -> HIplImage c d
 resize method w h img = 
     unsafePerformIO $
     do img' <- mkHIplImage w h
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index 6a13f49..f9e3b1d 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -19,11 +19,11 @@ foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
 -- increments; the fifth is the size of the scanned neighborhood in
 -- pixels around the block. The result is a pair of the horizontal and
 -- vertical components of optical flow.
-calcOpticalFlowBM :: HIplImage a MonoChromatic Word8 -> 
-                     HIplImage b MonoChromatic Word8 -> 
+calcOpticalFlowBM :: HIplImage MonoChromatic Word8 -> 
+                     HIplImage MonoChromatic Word8 -> 
                      (Int,Int) -> (Int,Int) -> (Int,Int) -> 
-                     (HIplImage FreshImage MonoChromatic Float, 
-                      HIplImage FreshImage MonoChromatic Float)
+                     (HIplImage MonoChromatic Float, 
+                      HIplImage MonoChromatic Float)
 calcOpticalFlowBM prev curr blockSize shiftSize maxRange = 
     unsafePerformIO $
     do velX <- mkHIplImage w h 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index b9e0451..3a0364a 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -20,8 +20,7 @@ import Unsafe.Coerce (unsafeCoerce)
 -- pixel data that excludes these unused bytes. If the original image
 -- data is already packed, it is returned as a 'V.Vector' without
 -- copying.
-packPixels :: (HasChannels c, HasDepth d) => 
-              HIplImage a c d -> V.Vector d
+packPixels :: (HasChannels c, HasDepth d) => HIplImage c d -> V.Vector d
 packPixels img = 
     if w' == stride 
     then pixels img
@@ -47,7 +46,7 @@ packPixels img =
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: HasDepth d => Int -> HIplImage a TriChromatic d -> V.Vector d
+isolateChannel :: HasDepth d => Int -> HIplImage TriChromatic d -> V.Vector d
 isolateChannel ch img = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"
@@ -66,8 +65,7 @@ isolateChannel ch img =
 {-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, HasDepth d, Integral d) => 
-          HIplImage a c d -> V.Vector d
+toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> V.Vector d
 toMono img = if imgChannels img == 1 then packPixels img
              else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
 
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 621985b..b84754c 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -40,8 +40,8 @@ foreign import ccall unsafe "opencv/cv.h cvThreshold"
 
 -- The worker function that calls c_cvThreshold.
 cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-               d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
-               (HIplImage FreshImage MonoChromatic d2, d1)
+               d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
+               (HIplImage MonoChromatic d2, d1)
 cvThreshold threshold maxValue tType src = 
     unsafePerformIO $
     withHIplImage src $ \srcPtr ->
@@ -55,14 +55,14 @@ cvThreshold threshold maxValue tType src =
           tType' = fromIntegral tType
 
 cvThreshold1 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-               d1 -> d1 -> Int -> HIplImage a MonoChromatic d1 ->
-               HIplImage FreshImage MonoChromatic d2
+               d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
+               HIplImage MonoChromatic d2
 cvThreshold1 threshold maxValue tType src = 
     fst $ cvThreshold threshold maxValue tType src
 
 unsafeCvThreshold :: ByteOrFloat d1 =>
-                     d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
-                     (HIplImage FreshImage MonoChromatic d1, d1)
+                     d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
+                     (HIplImage MonoChromatic d1, d1)
 unsafeCvThreshold threshold maxValue tType src = 
     unsafePerformIO $
     withHIplImage src $ \srcPtr ->
@@ -74,21 +74,28 @@ unsafeCvThreshold threshold maxValue tType src =
           tType' = fromIntegral tType
 
 unsafeCvThreshold1 :: ByteOrFloat d1 =>
-                      d1 -> d1 -> Int -> HIplImage FreshImage MonoChromatic d1 ->
-                      HIplImage FreshImage MonoChromatic d1
+                      d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
+                      HIplImage MonoChromatic d1
 unsafeCvThreshold1 th mv tt = fst . unsafeCvThreshold th mv tt
 
+{-# RULES 
+"cvThreshold1/in-place" forall t mv tt.
+  cvThreshold1 t mv tt = pipeline (unsafeCvThreshold1 t mv tt)
+"cvThreshold/in-place" forall t mv tt.
+  cvThreshold t mv tt = pipeline (unsafeCvThreshold t mv tt)
+  #-}
+
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
-cvThresholdOtsu :: Word8 -> Int -> HIplImage a MonoChromatic Word8 ->
-                   (HIplImage FreshImage MonoChromatic Word8, Word8)
+cvThresholdOtsu :: Word8 -> Int -> HIplImage MonoChromatic Word8 ->
+                   (HIplImage MonoChromatic Word8, Word8)
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
 
 unsafeCvThresholdOtsu :: Word8 -> Int -> 
-                         HIplImage FreshImage MonoChromatic Word8 ->
-                         (HIplImage FreshImage MonoChromatic Word8, Word8)
+                         HIplImage MonoChromatic Word8 ->
+                         (HIplImage MonoChromatic Word8, Word8)
 unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
@@ -98,8 +105,8 @@ unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
 thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-                   d1 -> d1 -> HIplImage a MonoChromatic d1 ->
-                   HIplImage FreshImage MonoChromatic d2
+                   d1 -> d1 -> HIplImage MonoChromatic d1 ->
+                   HIplImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
@@ -107,91 +114,84 @@ thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
 thresholdBinaryInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-                      d1 -> d1 -> HIplImage a MonoChromatic d1 ->
-                      HIplImage FreshImage MonoChromatic d2
+                      d1 -> d1 -> HIplImage MonoChromatic d1 ->
+                      HIplImage MonoChromatic d2
 thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
 unsafeThreshBin :: ByteOrFloat d =>
-                   d -> d -> HIplImage FreshImage MonoChromatic d ->
-                   HIplImage FreshImage MonoChromatic d
+                   d -> d -> HIplImage MonoChromatic d ->
+                   HIplImage MonoChromatic d
 unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinary
 
 unsafeThreshBinInv :: ByteOrFloat d =>
-                      d -> d -> HIplImage FreshImage MonoChromatic d ->
-                      HIplImage FreshImage MonoChromatic d
+                      d -> d -> HIplImage MonoChromatic d ->
+                      HIplImage MonoChromatic d
 unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
-{-# RULES "thresholdBinary/in-place"
-  forall th mv (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdBinary th mv . g = unsafeThreshBin th mv . g
+{-# RULES 
+"thresholdBinary/in-place" forall th mv. 
+  thresholdBinary th mv = pipeline (unsafeThreshBin th mv)
+"thresholdBinaryInv/in-place" forall th mv. 
+  thresholdBinaryInv th mv = pipeline (unsafeThreshBinInv th mv)
   #-}
 
-{-# RULES "thresholdBinaryInv/in-place"
-  forall th mv (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdBinaryInv th mv . g = unsafeThreshBinInv th mv . g
-  #-}
-
-
 -- |Truncation thresholding (i.e. clamping). Parameters are the
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
 thresholdTruncate :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                     d1 -> HIplImage a MonoChromatic d1 ->
-                     HIplImage FreshImage MonoChromatic d2
+                     d1 -> HIplImage MonoChromatic d1 ->
+                     HIplImage MonoChromatic d2
 thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
 
 unsafeThreshTrunc :: ByteOrFloat d1 =>
-                     d1 -> HIplImage FreshImage MonoChromatic d1 ->
-                     HIplImage FreshImage MonoChromatic d1
+                     d1 -> HIplImage MonoChromatic d1 ->
+                     HIplImage MonoChromatic d1
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncate/in-place"
-  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdTruncate th . g = unsafeThreshTrunc th . g
+{-# RULES "thresholdTruncate/in-place" forall th. 
+  thresholdTruncate th = pipeline (unsafeThreshTrunc th)
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
 thresholdToZero :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                   d1 -> HIplImage a MonoChromatic d1 ->
-                   HIplImage FreshImage MonoChromatic d2
+                   d1 -> HIplImage MonoChromatic d1 ->
+                   HIplImage MonoChromatic d2
 thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
 thresholdToZeroInv :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                      d1 -> HIplImage a MonoChromatic d1 ->
-                      HIplImage FreshImage MonoChromatic d2
+                      d1 -> HIplImage MonoChromatic d1 ->
+                      HIplImage MonoChromatic d2
 thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 
 unsafeThresholdToZero :: ByteOrFloat d => 
-                         d -> HIplImage FreshImage MonoChromatic d ->
-                         HIplImage FreshImage MonoChromatic d
+                         d -> HIplImage MonoChromatic d ->
+                         HIplImage MonoChromatic d
 unsafeThresholdToZero th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZero
 
 unsafeThresholdToZeroInv :: ByteOrFloat d => 
-                            d -> HIplImage FreshImage MonoChromatic d ->
-                            HIplImage FreshImage MonoChromatic d
+                            d -> HIplImage MonoChromatic d ->
+                            HIplImage MonoChromatic d
 unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZeroInv
 
 
-{-# RULES "thresholdToZero/in-place" 
-  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdToZero th . g = unsafeThresholdToZero th . g
+{-# RULES "thresholdToZero/in-place" forall th. 
+  thresholdToZero th = pipeline (unsafeThresholdToZero th)
   #-}
 
-{-# RULES "thresholdToZeroInv/in-place" 
-  forall th (g::a -> HIplImage FreshImage MonoChromatic d).
-  thresholdToZeroInv th . g = unsafeThresholdToZeroInv th . g
+{-# RULES "thresholdToZeroInv/in-place" forall th. 
+  thresholdToZeroInv th = pipeline (unsafeThresholdToZeroInv th)
   #-}
 
 
@@ -199,8 +199,8 @@ unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'.
-thresholdBinaryOtsu :: Word8 -> HIplImage a MonoChromatic Word8 ->
-                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdBinaryOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
+                       (HIplImage MonoChromatic Word8, Word8)
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
 
@@ -209,30 +209,27 @@ thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'. The sense of the
 -- thresholding operation is inverted, as in 'thresholdBinaryInv'.
-thresholdBinaryOtsuInv :: Word8 -> HIplImage a MonoChromatic Word8 ->
-                          (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdBinaryOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
+                          (HIplImage MonoChromatic Word8, Word8)
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
-unsafeBinOtsu :: Word8 -> HIplImage FreshImage MonoChromatic Word8 ->
-                 (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeBinOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
+                 (HIplImage MonoChromatic Word8, Word8)
 unsafeBinOtsu maxValue = unsafeCvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
 
-unsafeBinOtsuInv :: Word8 -> HIplImage FreshImage MonoChromatic Word8 ->
-                    (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeBinOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
+                    (HIplImage MonoChromatic Word8, Word8)
 unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
 
-{-# RULES "thresholdBinaryOtsu/in-place"
-  forall mv (g::a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdBinaryOtsu mv . g = unsafeBinOtsu mv . g
-  #-}
-
-{-# RULES "thresholdBinaryOtsuInv/in-place"
-  forall mv (g::a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdBinaryOtsuInv mv . g = unsafeBinOtsuInv mv . g
+{-# RULES 
+"thresholdBinaryOtsu/in-place" forall mv. 
+  thresholdBinaryOtsu mv = pipeline (unsafeBinOtsu mv)
+"thresholdBinaryOtsuInv/in-place" forall mv. 
+  thresholdBinaryOtsuInv mv = pipeline (unsafeBinOtsuInv mv)
   #-}
 
 
@@ -240,49 +237,45 @@ unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
 -- and returned along with the thresholded image.
-thresholdTruncateOtsu :: HIplImage a MonoChromatic Word8 -> 
-                         (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdTruncateOtsu :: HIplImage MonoChromatic Word8 -> 
+                         (HIplImage MonoChromatic Word8, Word8)
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
-unsafeTruncOtsu :: HIplImage FreshImage MonoChromatic Word8 -> 
-                   (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeTruncOtsu :: HIplImage MonoChromatic Word8 -> 
+                   (HIplImage MonoChromatic Word8, Word8)
 unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncateOtsu/in-place"
-  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdTruncateOtsu . g = unsafeTruncOtsu . g
+{-# RULES "thresholdTruncateOtsu/in-place" 
+  thresholdTruncateOtsu = pipeline unsafeTruncOtsu
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged.The @threshold@ value is chosen
 -- using Otsu's method and returned along with the thresholded image.
-thresholdToZeroOtsu :: HIplImage a MonoChromatic Word8 -> 
-                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
+                       (HIplImage MonoChromatic Word8, Word8)
 thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
 
 -- |Maps pixels that are greather than @threshold@ to zero; leaves all
 -- other pixels unchaged.The @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
-thresholdToZeroOtsuInv :: HIplImage a MonoChromatic Word8 -> 
-                          (HIplImage FreshImage MonoChromatic Word8, Word8)
+thresholdToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
+                          (HIplImage MonoChromatic Word8, Word8)
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
 
-unsafeToZeroOtsu :: HIplImage FreshImage MonoChromatic Word8 -> 
-                    (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
+                    (HIplImage MonoChromatic Word8, Word8)
 unsafeToZeroOtsu = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZero
 
-unsafeToZeroOtsuInv :: HIplImage FreshImage MonoChromatic Word8 -> 
-                       (HIplImage FreshImage MonoChromatic Word8, Word8)
+unsafeToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
+                       (HIplImage MonoChromatic Word8, Word8)
 unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZeroInv
 
-{-# RULES "thresholdToZeroOtsu/in-place"
-  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdToZeroOtsu . g = unsafeToZeroOtsu . g
-  #-}
-
-{-# RULES "thresholdToZeroOtsuInv/in-place"
-  forall (g :: a -> HIplImage FreshImage MonoChromatic Word8).
-  thresholdToZeroOtsuInv . g = unsafeToZeroOtsuInv . g
+{-# RULES 
+"thresholdToZeroOtsu/in-place" 
+  thresholdToZeroOtsu = pipeline unsafeToZeroOtsu
+"thresholdToZeroOtsuInv/in-place"
+  thresholdToZeroOtsuInv = pipeline unsafeToZeroOtsuInv
   #-}

From 9a31eacab1346d881ca04f5a1306efef2c4ba118 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 30 Aug 2010 18:24:02 -0400
Subject: [PATCH 052/137] Converted unsafe operations to live in IO. pipeline
 does the cast.

By leaving the unsafe operations in the IO monad, the strictness of
the pipeline function is more clear. Previously, a strictness
annotation was required in order to make explicit the dependency
of a processing operation on the image data it is supplied to deal
with the effects of calling unsafePerformIO on that image data.

With pipeline now using standard monadic sequencing, all the unsafe
operations are wrapped with the same unsafePerformIO, so no extra
annotation is needed to ensure the correct strictness properties.
---
 src/AI/CV/OpenCV/ArrayOps.hs       | 56 +++++++++++++-----------------
 src/AI/CV/OpenCV/Core/HIplUtils.hs |  9 ++---
 src/AI/CV/OpenCV/Filtering.hsc     |  5 ++-
 src/AI/CV/OpenCV/HighCV.hs         | 20 +++++------
 src/AI/CV/OpenCV/Threshold.hs      | 29 ++++++++--------
 5 files changed, 54 insertions(+), 65 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 6d036be..dc5c72a 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -29,9 +29,8 @@ subRS value src = unsafePerformIO $
 -- scalar value.
 unsafeSubRS :: (HasChannels c, HasDepth d, HasScalar c d,
                 IsCvScalar s, s ~ CvScalar c d) =>
-               s -> HIplImage c d -> HIplImage c d
-unsafeSubRS value src = unsafePerformIO $
-                        withHIplImage src $ \srcPtr ->
+               s -> HIplImage c d -> IO (HIplImage c d)
+unsafeSubRS value src = withHIplImage src $ \srcPtr ->
                             do c_cvSubRS (castPtr srcPtr) r g b a
                                          (castPtr srcPtr) nullPtr
                                return src
@@ -54,9 +53,8 @@ absDiff src1 src2 = unsafePerformIO $
                                       (castPtr dst)
 
 unsafeAbsDiff :: (HasChannels c, HasDepth d) => 
-                 HIplImage c d -> HIplImage c d -> HIplImage c d
-unsafeAbsDiff src1 src2 = unsafePerformIO $
-                          withHIplImage src1 $ \src1' ->
+                 HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
+unsafeAbsDiff src1 src2 = withHIplImage src1 $ \src1' ->
                             withHIplImage src2 $ \src2' ->
                                 do c_cvAbsDiff (castPtr src1') (castPtr src2') 
                                                (castPtr src2')
@@ -118,20 +116,19 @@ cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                         cvAndAux src1' src2' dst nullPtr
 
 unsafeAnd :: (HasChannels c, HasDepth d) => 
-             HIplImage c d -> HIplImage c d -> HIplImage c d
-unsafeAnd src1 src2 = unsafePerformIO $
-                      withHIplImage src1 $ \src1' ->
+             HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
+unsafeAnd src1 src2 = withHIplImage src1 $ \src1' ->
                         withHIplImage src2 $ \src2' ->
                           cvAndAux src1' src2' src2' nullPtr >> return src2
 
 unsafeAndMask :: (HasChannels c, HasDepth d) => 
                  HIplImage MonoChromatic Word8 -> HIplImage c d ->  
-                 HIplImage c d -> HIplImage c d
-unsafeAndMask mask src1 src2 = unsafePerformIO $
-                      withHIplImage src1 $ \src1' ->
-                        withHIplImage src2 $ \src2' ->
-                          withHIplImage mask $ \mask' ->
-                            cvAndAux src1' src2' src2' mask' >> return src2
+                 HIplImage c d -> IO (HIplImage c d)
+unsafeAndMask mask src1 src2 = withHIplImage src1 $ \src1' ->
+                                 withHIplImage src2 $ \src2' ->
+                                   withHIplImage mask $ \mask' ->
+                                     cvAndAux src1' src2' src2' mask' >> 
+                                     return src2
 
 {-# RULES 
 "cvAnd/in-place" forall s. cvAnd s = pipeline (unsafeAnd s)
@@ -153,9 +150,8 @@ cvAndS s img = fst . withCompatibleImage img $ \dst ->
 
 unsafeAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
                s ~ CvScalar c d) => 
-              s -> HIplImage c d -> HIplImage c d
-unsafeAndS s img = unsafePerformIO $
-                   do withHIplImage img $ \src ->
+              s -> HIplImage c d -> IO (HIplImage c d)
+unsafeAndS s img = do withHIplImage img $ \src ->
                         c_cvAndS (castPtr src) r g b a (castPtr src) nullPtr
                       return img
     where (r,g,b,a) = toCvScalar s
@@ -201,17 +197,15 @@ cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                                    cvMulAux src1' src2' dst scale
 
 unsafeMul :: (HasChannels c, HasDepth d) => 
-             HIplImage c d -> HIplImage c d -> HIplImage c d
-unsafeMul src1 src2 = unsafePerformIO $
-                      do withHIplImage src1 $ \src1' ->
+             HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
+unsafeMul src1 src2 = do withHIplImage src1 $ \src1' ->
                              withHIplImage src2 $ \src2' ->
                                  cvMulAux src1' src2' src2' 1
                          return src2
 
 unsafeMul' :: (HasChannels c, HasDepth d) => 
-              Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
-unsafeMul' scale src1 src2 = unsafePerformIO $
-                             do withHIplImage src1 $ \src1' ->
+              Double -> HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
+unsafeMul' scale src1 src2 = do withHIplImage src1 $ \src1' ->
                                   withHIplImage src2 $ \src2' ->
                                     cvMulAux src1' src2' src2' scale
                                 return src2
@@ -234,9 +228,8 @@ cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                                  (castPtr dst) nullPtr
 
 unsafeAdd  :: (HasChannels c, HasDepth d) => 
-              HIplImage c d -> HIplImage c d -> HIplImage c d
-unsafeAdd src1 src2 = unsafePerformIO $
-                      do withHIplImage src1 $ \src1' ->
+              HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
+unsafeAdd src1 src2 = do withHIplImage src1 $ \src1' ->
                            withHIplImage src2 $ \src2' ->
                              c_cvAdd (castPtr src1') (castPtr src2') 
                                      (castPtr src2') nullPtr
@@ -254,11 +247,10 @@ cvAddS scalar src = fst . withCompatibleImage src $ \dst ->
     where (r,g,b,a) = toCvScalar scalar
 
 unsafeAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-              s -> HIplImage c d -> HIplImage c d
-unsafeAddS scalar src = unsafePerformIO $ do
-                        withHIplImage src $ \src' ->
-                          c_cvAddS (castPtr src') r g b a (castPtr src') nullPtr
-                        return src
+              s -> HIplImage c d -> IO (HIplImage c d)
+unsafeAddS scalar src = do withHIplImage src $ \src' ->
+                             c_cvAddS (castPtr src') r g b a (castPtr src') nullPtr
+                           return src
     where (r,g,b,a) = toCvScalar scalar
 
 {-# RULES
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index c778eb3..bce57d4 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -221,12 +221,13 @@ getROI (rx,ry) (rw,rh) src =
           bpp = imgChannels src * colorDepth src
           rowLen = rw*bpp
 
-pipeline :: (HIplImage c d -> r) -> HIplImage c d -> r
-pipeline f = unsafePerformIO . (return . (f $!) <=< duplicateImage)
+pipeline :: (HIplImage c d -> IO r) -> HIplImage c d -> r
+--pipeline f = unsafePerformIO . ((f $!) <=< duplicateImage)
+pipeline f = unsafePerformIO . (f <=< duplicateImage)
 
 {-# NOINLINE pipeline #-}
 
 {-# RULES
-"pipeline/join" forall f g h. pipeline f (pipeline g h) = pipeline (f . g) h
-"pipeline/compose" forall f g. pipeline f . pipeline g = pipeline (f. g)
+"pipeline/join" forall f g h. pipeline f (pipeline g h) = pipeline (f <=< g) h
+"pipeline/compose" forall f g. pipeline f . pipeline g = pipeline (f <=< g)
   #-}
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 5137ed1..f3eb409 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -54,9 +54,8 @@ smoothGaussian' w h sigma src =
 
 unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double ->
-                   HIplImage c d -> HIplImage c d
-unsafeGaussian w h sigma src = unsafePerformIO $ 
-                               withHIplImage src $ \src' ->
+                   HIplImage c d -> IO (HIplImage c d)
+unsafeGaussian w h sigma src = withHIplImage src $ \src' ->
                                  do smooth src' src' cvGaussian w h' sigma' 0
                                     return src
     where sigma' = case sigma of
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index a981b5b..b5bc082 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -53,9 +53,8 @@ dilate n img = unsafePerformIO . withHIplImage img $
 -- image and is only used by the rewrite rules when there is no way to
 -- observe the input image.
 unsafeErode :: (HasChannels c, HasDepth d) => 
-               Int -> HIplImage c d -> HIplImage c d
-unsafeErode n img = unsafePerformIO $
-                    withHIplImage img (\src -> cvErode src src n') >> 
+               Int -> HIplImage c d -> IO (HIplImage c d)
+unsafeErode n img = withHIplImage img (\src -> cvErode src src n') >> 
                     return (unsafeCoerce img)
     where n' = fromIntegral n
 
@@ -63,9 +62,8 @@ unsafeErode n img = unsafePerformIO $
 -- given image and is only used by the rewrite rules when there is no
 -- way to observe the input image.
 unsafeDilate :: (HasChannels c, HasDepth d) =>
-                Int -> HIplImage c d-> HIplImage c d
-unsafeDilate n img = unsafePerformIO $
-                     withHIplImage img (\src -> cvDilate src src n') >> 
+                Int -> HIplImage c d-> IO (HIplImage c d)
+unsafeDilate n img = withHIplImage img (\src -> cvDilate src src n') >> 
                      return (unsafeCoerce img)
     where n' = fromIntegral n
 
@@ -171,10 +169,10 @@ drawLines col thick lineType lines img =
 -- |Unsafe in-place line drawing.
 unsafeDrawLines :: (HasChannels c, HasDepth d) =>
                    RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-                   HIplImage c d -> HIplImage c d
+                   HIplImage c d -> IO (HIplImage c d)
 unsafeDrawLines col thick lineType lines img = 
-    unsafePerformIO . withHIplImage img $ \ptr -> 
-        mapM_ (draw ptr) lines >> return (unsafeCoerce img)
+    withHIplImage img $ \ptr -> 
+      mapM_ (draw ptr) lines >> return (unsafeCoerce img)
     where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 
@@ -197,9 +195,9 @@ cannyEdges threshold1 threshold2 aperture img =
 
 unsafeCanny :: HasDepth d =>
                Double -> Double -> Int -> HIplImage MonoChromatic d -> 
-               HIplImage MonoChromatic d
+               IO (HIplImage MonoChromatic d)
 unsafeCanny threshold1 threshold2 aperture img = 
-    unsafePerformIO . withHIplImage img $ \src -> 
+    withHIplImage img $ \src -> 
         cvCanny src src threshold1 threshold2 aperture >> return img
 
 {-# RULES "canny/in-place" forall t1 t2 a.
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index b84754c..8c13be5 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -62,9 +62,8 @@ cvThreshold1 threshold maxValue tType src =
 
 unsafeCvThreshold :: ByteOrFloat d1 =>
                      d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-                     (HIplImage MonoChromatic d1, d1)
+                     IO (HIplImage MonoChromatic d1, d1)
 unsafeCvThreshold threshold maxValue tType src = 
-    unsafePerformIO $
     withHIplImage src $ \srcPtr ->
       do r <- c_cvThreshold (castPtr srcPtr) (castPtr srcPtr) 
                              threshold' maxValue' tType'
@@ -75,8 +74,8 @@ unsafeCvThreshold threshold maxValue tType src =
 
 unsafeCvThreshold1 :: ByteOrFloat d1 =>
                       d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-                      HIplImage MonoChromatic d1
-unsafeCvThreshold1 th mv tt = fst . unsafeCvThreshold th mv tt
+                      IO (HIplImage MonoChromatic d1)
+unsafeCvThreshold1 th mv tt = fmap fst . unsafeCvThreshold th mv tt
 
 {-# RULES 
 "cvThreshold1/in-place" forall t mv tt.
@@ -95,7 +94,7 @@ cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
 
 unsafeCvThresholdOtsu :: Word8 -> Int -> 
                          HIplImage MonoChromatic Word8 ->
-                         (HIplImage MonoChromatic Word8, Word8)
+                         IO (HIplImage MonoChromatic Word8, Word8)
 unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
@@ -121,13 +120,13 @@ thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
 
 unsafeThreshBin :: ByteOrFloat d =>
                    d -> d -> HIplImage MonoChromatic d ->
-                   HIplImage MonoChromatic d
+                   IO (HIplImage MonoChromatic d)
 unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinary
 
 unsafeThreshBinInv :: ByteOrFloat d =>
                       d -> d -> HIplImage MonoChromatic d ->
-                      HIplImage MonoChromatic d
+                      IO (HIplImage MonoChromatic d)
 unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
@@ -149,7 +148,7 @@ thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
 
 unsafeThreshTrunc :: ByteOrFloat d1 =>
                      d1 -> HIplImage MonoChromatic d1 ->
-                     HIplImage MonoChromatic d1
+                     IO (HIplImage MonoChromatic d1)
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
 {-# RULES "thresholdTruncate/in-place" forall th. 
@@ -175,13 +174,13 @@ thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
 
 unsafeThresholdToZero :: ByteOrFloat d => 
                          d -> HIplImage MonoChromatic d ->
-                         HIplImage MonoChromatic d
+                         IO (HIplImage MonoChromatic d)
 unsafeThresholdToZero th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZero
 
 unsafeThresholdToZeroInv :: ByteOrFloat d => 
                             d -> HIplImage MonoChromatic d ->
-                            HIplImage MonoChromatic d
+                            IO (HIplImage MonoChromatic d)
 unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZeroInv
 
@@ -215,12 +214,12 @@ thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
 unsafeBinOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
-                 (HIplImage MonoChromatic Word8, Word8)
+                 IO (HIplImage MonoChromatic Word8, Word8)
 unsafeBinOtsu maxValue = unsafeCvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
 
 unsafeBinOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
-                    (HIplImage MonoChromatic Word8, Word8)
+                    IO (HIplImage MonoChromatic Word8, Word8)
 unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
@@ -242,7 +241,7 @@ thresholdTruncateOtsu :: HIplImage MonoChromatic Word8 ->
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
 unsafeTruncOtsu :: HIplImage MonoChromatic Word8 -> 
-                   (HIplImage MonoChromatic Word8, Word8)
+                   IO (HIplImage MonoChromatic Word8, Word8)
 unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
 {-# RULES "thresholdTruncateOtsu/in-place" 
@@ -264,12 +263,12 @@ thresholdToZeroOtsuInv :: HIplImage MonoChromatic Word8 ->
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
 
 unsafeToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
-                    (HIplImage MonoChromatic Word8, Word8)
+                    IO (HIplImage MonoChromatic Word8, Word8)
 unsafeToZeroOtsu = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZero
 
 unsafeToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
-                       (HIplImage MonoChromatic Word8, Word8)
+                       IO (HIplImage MonoChromatic Word8, Word8)
 unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZeroInv
 

From e26ed72686a2fa2696c222d75ee410aa066cfe10 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 30 Aug 2010 21:03:22 -0400
Subject: [PATCH 053/137] Added build instructions for Windows.

---
 HOpenCV.cabal | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 0a91c8f..e553a4b 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -12,7 +12,9 @@ description:
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04 and Mac OS 10.5 and 10.6.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6, and Windows XP.
+   .
+   On Windows, OpenCV is assumed to be installed in the @C:\\OpenCV2.1@ directory.
    .
    /Usage/
    .
@@ -44,7 +46,12 @@ library
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
    hs-Source-Dirs: src
-   extra-libraries: cxcore,cv,highgui
+   if os(windows)
+     include-dirs: C:\\OpenCV2.1\\include
+     extra-lib-dirs:     C:\\OpenCV2.1\\bin
+     extra-libraries: cxcore210, cv210, highgui210
+   else
+     extra-libraries: cxcore,cv,highgui
    build-depends: base >=4 && <5, 
                   allocated-processor >= 0.0.1, 
                   vector-space,

From 8ec78c82e039ffb37d70d0cc6fd44295d4915a46 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 31 Aug 2010 11:51:01 -0400
Subject: [PATCH 054/137] Added synonyms for grayscale and color 8-bit images.

---
 src/AI/CV/OpenCV/HighCV.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index b5bc082..b881525 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -12,8 +12,8 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, createVideoWriter, HasChannels,
-                            module AI.CV.OpenCV.ColorConversion, 
-                            createFileCaptureLoop)
+                            module AI.CV.OpenCV.ColorConversion, GrayImage,
+                            ColorImage, createFileCaptureLoop)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
@@ -31,6 +31,12 @@ import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
 import Unsafe.Coerce
 
+-- |Grayscale 8-bit (per-pixel) image type synonym.
+type GrayImage = HIplImage MonoChromatic Word8
+
+-- |Color 8-bit (per-color) image type synonym.
+type ColorImage = HIplImage TriChromatic Word8
+
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 erode :: (HasChannels c, HasDepth d) =>

From 50a1772711f33b38db0680208263ab4d6370bf8b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Tue, 31 Aug 2010 21:13:35 -0400
Subject: [PATCH 055/137] Improved the in-place mutation deforestation
 mechanisms.

Operations that can be performed in-place give rise to a pair of
functions: safe and unsafe. They are also equipped with a pair of
rewrite rules. The first rule rewrites a safe application into a
@pipeline (unsafe args...)@ call. The @pipeline@ function has
associated rewrite rules that collapse compositions of pipelined
functions. If a pipeline is not collapsed, then the second rule
associated with the original function can kick in. This rule
transforms @pipeline (unsafe args...)@ to @safe args...@.

Unfortunately, the phase control on these rules interacts with the
inliner in a fairly complex manner. To avoid un-deforested pipeline
calls, user code should be annotated {-# INLINE [2] foo #-}. This
annotation has the effect of letting both the pipeline rewrite fire in
an early phase, and then the unpipe rewrite to fire at a later phase
if necessary. Without this annotation, the worst case scenario is that
a function that could work with an uninitialized freshly allocated
buffer instead gets a buffer whose contents have been initialized via
a copy from an existing image.
---
 HOpenCV.cabal                       |  2 +
 src/AI/CV/OpenCV/ArrayOps.hs        | 62 ++++++++++++++--------
 src/AI/CV/OpenCV/Core/HIplUtils.hs  | 16 +++---
 src/AI/CV/OpenCV/Core/PipelineTH.hs | 60 +++++++++++++++++++++
 src/AI/CV/OpenCV/Filtering.hsc      | 32 +++++++----
 src/AI/CV/OpenCV/HighCV.hs          | 34 ++++++++----
 src/AI/CV/OpenCV/Threshold.hs       | 82 +++++++++++++++++++----------
 7 files changed, 209 insertions(+), 79 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/Core/PipelineTH.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index e553a4b..90b9729 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -45,6 +45,7 @@ library
       AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+   other-modules: AI.CV.OpenCV.Core.PipelineTH
    hs-Source-Dirs: src
    if os(windows)
      include-dirs: C:\\OpenCV2.1\\include
@@ -53,6 +54,7 @@ library
    else
      extra-libraries: cxcore,cv,highgui
    build-depends: base >=4 && <5, 
+                  template-haskell,
                   allocated-processor >= 0.0.1, 
                   vector-space,
                   directory >= 1.0.1.0 && < 1.1,
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index dc5c72a..1f029e9 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -36,7 +36,9 @@ unsafeSubRS value src = withHIplImage src $ \srcPtr ->
                                return src
     where (r,g,b,a) = toCvScalar value
 
-{-# RULES "subRS/in-place" forall v. subRS v = pipeline (unsafeSubRS v)
+{-# RULES 
+"subRS/in-place" [~1] forall v. subRS v = pipeline (unsafeSubRS v)
+"subRS/unpipe" [1] forall v. pipeline (unsafeSubRS v) = subRS v
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
@@ -60,7 +62,9 @@ unsafeAbsDiff src1 src2 = withHIplImage src1 $ \src1' ->
                                                (castPtr src2')
                                    return src2
 
-{-# RULES "absDiff/in-place" forall m. absDiff m = pipeline (unsafeAbsDiff m) 
+{-# RULES 
+"absDiff/in-place" [~1] forall m. absDiff m = pipeline (unsafeAbsDiff m)
+"absDiff/unpipe" [1] forall m. pipeline (unsafeAbsDiff m) = absDiff m
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
@@ -89,9 +93,10 @@ convertScale scale shift src = unsafePerformIO $
 foreign import ccall unsafe "opencv/cxcore.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvAndAux :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> IO ()
-cvAndAux src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
-                                      (castPtr dst) (castPtr mask)
+cvAndHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> 
+               IO ()
+cvAndHelper src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
+                                         (castPtr dst) (castPtr mask)
 
 -- |Calculate the per-element bitwise conjunction of two
 -- arrays. Parameters are a mask and two source images. The mask
@@ -105,7 +110,7 @@ cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
                              withHIplImage src1 $ \src1' ->
                                withHIplImage src2 $ \src2' ->
                                  withHIplImage mask $ \mask' ->
-                                   cvAndAux src1' src2' dst mask'
+                                   cvAndHelper src1' src2' dst mask'
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
@@ -113,13 +118,13 @@ cvAnd :: (HasChannels c, HasDepth d) =>
 cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
-                        cvAndAux src1' src2' dst nullPtr
+                        cvAndHelper src1' src2' dst nullPtr
 
 unsafeAnd :: (HasChannels c, HasDepth d) => 
              HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
 unsafeAnd src1 src2 = withHIplImage src1 $ \src1' ->
                         withHIplImage src2 $ \src2' ->
-                          cvAndAux src1' src2' src2' nullPtr >> return src2
+                          cvAndHelper src1' src2' src2' nullPtr >> return src2
 
 unsafeAndMask :: (HasChannels c, HasDepth d) => 
                  HIplImage MonoChromatic Word8 -> HIplImage c d ->  
@@ -127,12 +132,16 @@ unsafeAndMask :: (HasChannels c, HasDepth d) =>
 unsafeAndMask mask src1 src2 = withHIplImage src1 $ \src1' ->
                                  withHIplImage src2 $ \src2' ->
                                    withHIplImage mask $ \mask' ->
-                                     cvAndAux src1' src2' src2' mask' >> 
+                                     cvAndHelper src1' src2' src2' mask' >> 
                                      return src2
 
 {-# RULES 
-"cvAnd/in-place" forall s. cvAnd s = pipeline (unsafeAnd s)
-"cvAndMask/in-place" forall m s. cvAndMask m s = pipeline (unsafeAndMask m s)
+"cvAnd/in-place" [~1] forall s. cvAnd s = pipeline (unsafeAnd s)
+"cvAnd/unpipe" [1] forall s. pipeline (unsafeAnd s) = cvAnd s
+"cvAndMask/in-place" [~1] forall m s. 
+  cvAndMask m s = pipeline (unsafeAndMask m s)
+"cvAndMask/unpipe" [1] forall m s.
+  pipeline (unsafeAndMask m s) = cvAndMask m s
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAndS"
@@ -156,7 +165,10 @@ unsafeAndS s img = do withHIplImage img $ \src ->
                       return img
     where (r,g,b,a) = toCvScalar s
 
-{-# RULES "cvAndS/in-place" forall s. cvAndS s = pipeline (unsafeAndS s) #-}
+{-# RULES 
+"cvAndS/in-place" [~1] forall s. cvAndS s = pipeline (unsafeAndS s)
+"cvAndS/unpipe" [1] forall s. pipeline (unsafeAndS s) = cvAndS s
+  #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -175,9 +187,9 @@ cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
 foreign import ccall unsafe "opencv/cxcore.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
 
-cvMulAux :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
-cvMulAux src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2) 
-                                   (castPtr dst) (realToFrac s)
+cvMulHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
+cvMulHelper src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2) 
+                                      (castPtr dst) (realToFrac s)
 
 -- |Per-element product of two arrays.
 cvMul :: (HasChannels c, HasDepth d) => 
@@ -185,7 +197,7 @@ cvMul :: (HasChannels c, HasDepth d) =>
 cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                     withHIplImage src1 $ \src1' ->
                       withHIplImage src2 $ \src2' ->
-                        cvMulAux src1' src2' dst 1
+                        cvMulHelper src1' src2' dst 1
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
@@ -194,25 +206,27 @@ cvMul' :: (HasChannels c, HasDepth d) =>
 cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
                            withHIplImage src1 $ \src1' ->
                                withHIplImage src2 $ \src2' ->
-                                   cvMulAux src1' src2' dst scale
+                                   cvMulHelper src1' src2' dst scale
 
 unsafeMul :: (HasChannels c, HasDepth d) => 
              HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
 unsafeMul src1 src2 = do withHIplImage src1 $ \src1' ->
                              withHIplImage src2 $ \src2' ->
-                                 cvMulAux src1' src2' src2' 1
+                                 cvMulHelper src1' src2' src2' 1
                          return src2
 
 unsafeMul' :: (HasChannels c, HasDepth d) => 
               Double -> HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
 unsafeMul' scale src1 src2 = do withHIplImage src1 $ \src1' ->
                                   withHIplImage src2 $ \src2' ->
-                                    cvMulAux src1' src2' src2' scale
+                                    cvMulHelper src1' src2' src2' scale
                                 return src2
 
 {-# RULES 
-"cvMul/in-place" forall s1. cvMul s1 = pipeline (unsafeMul s1)
-"cvMul'/in-place" forall s s1. cvMul' s s1 = pipeline (unsafeMul' s s1)
+"cvMul/in-place" [~1] forall s1. cvMul s1 = pipeline (unsafeMul s1)
+"cvMul/unpipe" [1] forall s1. pipeline (unsafeMul s1) = cvMul s1
+"cvMul'/in-place" [~1] forall s s1. cvMul' s s1 = pipeline (unsafeMul' s s1)
+"cvMul'/unpipe" [1] forall s s1. pipeline (unsafeMul' s s1) = cvMul' s s1
   #-}
 
 foreign import ccall unsafe "opencv/cxcore.h cvAdd"
@@ -254,6 +268,8 @@ unsafeAddS scalar src = do withHIplImage src $ \src' ->
     where (r,g,b,a) = toCvScalar scalar
 
 {-# RULES
-"cvAdd/in-place" forall s. cvAdd s = pipeline (unsafeAdd s)
-"cvAddS/in-place" forall s. cvAddS s = pipeline (unsafeAddS s)
+"cvAdd/in-place" [~1] forall s. cvAdd s = pipeline (unsafeAdd s)
+"cvAdd/unpipe" [1] forall s. pipeline (unsafeAdd s) = cvAdd s
+"cvAddS/in-place" [~1] forall s. cvAddS s = pipeline (unsafeAddS s)
+"cvAddS/unpipe" [1] forall s. pipeline (unsafeAddS s) = cvAddS s
   #-}
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index bce57d4..8905e1d 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables, BangPatterns, MultiParamTypeClasses, 
+             FlexibleInstances #-}
 -- |Functions for working with 'HIplImage's.
 module AI.CV.OpenCV.Core.HIplUtils 
     (isColor, isMono, imgChannels, withPixels, pixels,
      fromPtr, fromFileColor, fromFileGray, toFile, 
-     compatibleImage, duplicateImage, fromPixels, 
+     compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, pipeline,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
@@ -137,7 +138,6 @@ withPixels w h pix f = if fromIntegral len == sz
           (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
                          (fp,0,len) -> (fp,len)
                          _ -> error "fromPixels non-zero offset"
-{-# INLINE [0] withImagePixels #-}
 
 -- |Construct a fresh 'HIplImage' from a width, a height, and a
 -- 'V.Vector' of pixel values.
@@ -222,12 +222,12 @@ getROI (rx,ry) (rw,rh) src =
           rowLen = rw*bpp
 
 pipeline :: (HIplImage c d -> IO r) -> HIplImage c d -> r
---pipeline f = unsafePerformIO . ((f $!) <=< duplicateImage)
 pipeline f = unsafePerformIO . (f <=< duplicateImage)
-
-{-# NOINLINE pipeline #-}
+{-# INLINE [0] pipeline #-}
 
 {-# RULES
-"pipeline/join" forall f g h. pipeline f (pipeline g h) = pipeline (f <=< g) h
-"pipeline/compose" forall f g. pipeline f . pipeline g = pipeline (f <=< g)
+"pipeline/join" forall f g h.
+  pipeline f (pipeline g h) = pipeline (f <=< g) h
+"pipeline/compose" forall f g.
+  pipeline f . pipeline g = pipeline (f <=< g)
   #-}
diff --git a/src/AI/CV/OpenCV/Core/PipelineTH.hs b/src/AI/CV/OpenCV/Core/PipelineTH.hs
new file mode 100644
index 0000000..580b4d6
--- /dev/null
+++ b/src/AI/CV/OpenCV/Core/PipelineTH.hs
@@ -0,0 +1,60 @@
+module AI.CV.OpenCV.Core.PipelineTH (mkPiped, mkAux) where
+import Control.Monad (when)
+import Data.List (foldl')
+import Language.Haskell.TH
+
+countArrows :: Type -> Int
+countArrows (ForallT _ _ t) = countArrows t
+countArrows ArrowT = 1
+countArrows (AppT t1 t2) = countArrows t1 + countArrows t2
+countArrows _ = 0
+
+getArity :: Exp -> Q Int
+getArity (VarE n) = do VarI _ t _ _ <- reify n
+                       return $ countArrows t
+getArity _ = error "getArity called with non VarE expression"
+
+-- Declare an alias of a variable @foo@ named @fooAux@ that is
+-- semantically equivalent to the original.
+mkAux :: Q Exp -> Q [Dec]
+mkAux q = do VarE n <- q
+             VarI _ t _ _ <- reify n
+             let n' = mkName $ nameBase n ++ "Aux"
+                 spec = InlineSpec True False (Just (True,1))
+             return [ SigD n' t
+                    , FunD n' [Clause [] (NormalB (VarE n)) []] 
+                    , PragmaD $ InlineP n' spec ]
+
+-- Takes variables bound to safe and the unsafe functions. Generates
+-- an auxiliary function semantically equivalent to the safe function
+-- with the name "fooAux" (for a function named "foo"), and a
+-- pipelined function of the form @fooPiped x y = pipeline (unsafe x y)
+-- (fooAux x y)@. The safe function's type must be no less general
+-- than the unsafe function's.
+mkPiped :: Q Exp -> Q [Dec]
+mkPiped pair = do TupE [f1,f2] <- pair
+                  arity <- getArity f1
+                  arity' <- getArity f2
+                  when (arity /= arity')
+                       (error $ "Arities of functions passed to "++
+                                "mkPipe do not match")
+                  let VarE f1Name = f1
+                      -- VarE f2Name = f2
+                  VarI _ t1 _ _ <- reify f1Name
+                  --VarI _ t2 _ _ <- reify f2Name
+                  let nameAux = mkName $ nameBase f1Name ++ "Aux"
+                      namePiped = mkName $ nameBase f1Name ++ "Piped"
+                      auxSpec = InlineSpec True False (Just (True, 1))
+                      pipeSpec = InlineSpec True True Nothing
+                      fAux = VarE nameAux
+                  names <- mapM newName (take (arity - 1) (repeat "x"))
+                  let app1 = foldl' AppE fAux (map VarE names)
+                      app2 = foldl' AppE f2 (map VarE names)
+                      pipe = AppE (AppE (VarE (mkName "pipeline")) app2) app1
+                  return [ SigD nameAux t1
+                         , FunD nameAux [Clause [] (NormalB f1) []]
+                         , PragmaD $ InlineP nameAux auxSpec
+                         --, SigD namePiped t2
+                         , FunD namePiped [Clause (map VarP names) 
+                                                  (NormalB pipe) []]
+                         , PragmaD $ InlineP namePiped pipeSpec ]
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index f3eb409..0beb160 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -34,6 +34,7 @@ cvGaussian = #{const CV_GAUSSIAN}
 smoothGaussian :: (ByteOrFloat d, HasChannels c) => 
                   Int -> HIplImage c d -> HIplImage c d
 smoothGaussian w = smoothGaussian' w Nothing Nothing
+{-# INLINE [0] smoothGaussian #-}
 
 -- |Smooth a source 'HIplImage' using a linear convolution with a
 -- Gaussian kernel. Parameters are the kernel width, the kernel height
@@ -51,21 +52,32 @@ smoothGaussian' w h sigma src =
         smooth src' dst cvGaussian w h' sigma' 0
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
           h' = case h of { Nothing -> 0; Just jh -> jh }
+{-# INLINE [0] smoothGaussian' #-}
 
-unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
-                   Int -> Maybe Int -> Maybe Double ->
-                   HIplImage c d -> IO (HIplImage c d)
-unsafeGaussian w h sigma src = withHIplImage src $ \src' ->
-                                 do smooth src' src' cvGaussian w h' sigma' 0
-                                    return src
+unsafeGaussian'  :: (ByteOrFloat d, HasChannels c) => 
+                    Int -> Maybe Int -> Maybe Double ->
+                    HIplImage c d -> IO (HIplImage c d)
+unsafeGaussian' w h sigma src = withHIplImage src $ \src' ->
+                                  do smooth src' src' cvGaussian w h' sigma' 0
+                                     return src
     where sigma' = case sigma of
                      Nothing -> 0
                      Just s -> realToFrac s
           h' = case h of { Nothing -> 0; Just jh -> jh }
+{-# INLINE [0] unsafeGaussian' #-}
+
+unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
+                    Int -> HIplImage c d -> IO (HIplImage c d)
+unsafeGaussian w = unsafeGaussian' w Nothing Nothing
+{-# INLINE [0] unsafeGaussian #-}
 
 {-# RULES 
-"smoothGaussian'/in-place" forall w h sigma. 
-  smoothGaussian' w h sigma = pipeline (unsafeGaussian w h sigma)
-"smoothGaussian/in-place" forall w. 
-  smoothGaussian w = pipeline (unsafeGaussian w Nothing Nothing)
+"smoothGaussian'/in-place" [~1] forall w h sigma. 
+  smoothGaussian' w h sigma = pipeline (unsafeGaussian' w h sigma)
+"smoothGaussian'/unpipe" [1] forall w h sigma.
+  pipeline (unsafeGaussian' w h sigma) = smoothGaussian' w h sigma
+"smoothGaussian/in-place" [~1] forall w. 
+  smoothGaussian w = pipeline (unsafeGaussian w)
+"smoothGaussian/unpipe" [1] forall w.
+  pipeline (unsafeGaussian w) = smoothGaussian w
   #-}
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index b881525..480b0ed 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -13,7 +13,8 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, createVideoWriter, HasChannels,
                             module AI.CV.OpenCV.ColorConversion, GrayImage,
-                            ColorImage, createFileCaptureLoop)
+                            ColorImage, createFileCaptureLoop, 
+                            module AI.CV.OpenCV.Threshold)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
@@ -30,6 +31,7 @@ import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
 import Unsafe.Coerce
+import AI.CV.OpenCV.Threshold
 
 -- |Grayscale 8-bit (per-pixel) image type synonym.
 type GrayImage = HIplImage MonoChromatic Word8
@@ -45,6 +47,7 @@ erode n img = unsafePerformIO . withHIplImage img $
               \src -> return . fst . withCompatibleImage img $
                       \dst -> cvErode src dst n'
     where n' = fromIntegral n
+{-# INLINE [0] erode #-}
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
@@ -54,6 +57,7 @@ dilate n img = unsafePerformIO . withHIplImage img $
                \src -> return . fst . withCompatibleImage img $
                        \dst -> cvDilate src dst n'
     where n' = fromIntegral n
+{-# INLINE [0] dilate #-}
 
 -- |Unsafe in-place erosion. This is a destructive update of the given
 -- image and is only used by the rewrite rules when there is no way to
@@ -63,6 +67,7 @@ unsafeErode :: (HasChannels c, HasDepth d) =>
 unsafeErode n img = withHIplImage img (\src -> cvErode src src n') >> 
                     return (unsafeCoerce img)
     where n' = fromIntegral n
+{-# INLINE [0] unsafeErode #-}
 
 -- |Unsafe in-place dilation. This is a destructive update of the
 -- given image and is only used by the rewrite rules when there is no
@@ -72,16 +77,13 @@ unsafeDilate :: (HasChannels c, HasDepth d) =>
 unsafeDilate n img = withHIplImage img (\src -> cvDilate src src n') >> 
                      return (unsafeCoerce img)
     where n' = fromIntegral n
-
--- Perform destructive in-place updates when such a change is
--- safe. Safety is indicated by the phantom type tag annotating
--- HIplImage. If we have a function yielding an HIplImage FreshImage,
--- then we can clobber it. That is the *only* time these in-place
--- operations are known to be safe.
+{-# INLINE [0] unsafeDilate #-}
 
 {-# RULES 
-"erode/in-place"  forall n. erode n = pipeline (unsafeErode n)
-"dilate/in-place" forall n. dilate n = pipeline (unsafeDilate n)
+"erode/in-place" [~1] forall n. erode n = pipeline (unsafeErode n)
+"erode/unpipe" [1] forall n. pipeline (unsafeErode n) = erode n
+"dilate/in-place" [~1] forall n. dilate n = pipeline (unsafeDilate n)
+"dilate/unpipe" [1] forall n. pipeline (unsafeDilate n) = dilate n
   #-}
 
 -- |Extract all the pixel values from an image along a line, including
@@ -171,6 +173,7 @@ drawLines col thick lineType lines img =
     fst $ withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
+{-# INLINE [0] drawLines #-}
 
 -- |Unsafe in-place line drawing.
 unsafeDrawLines :: (HasChannels c, HasDepth d) =>
@@ -181,9 +184,13 @@ unsafeDrawLines col thick lineType lines img =
       mapM_ (draw ptr) lines >> return (unsafeCoerce img)
     where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
+{-# INLINE [0] unsafeDrawLines #-}
 
-{-# RULES "drawLines/in-place" forall c t lt lns. 
+{-# RULES 
+"drawLines/in-place" [~1] forall c t lt lns. 
   drawLines c t lt lns = pipeline (unsafeDrawLines c t lt lns)
+"drawLines/unpipe" [1] forall c t lt lns.
+  pipeline (unsafeDrawLines c t lt lns) = drawLines c t lt lns
   #-}
 
 -- |Find edges using the Canny algorithm. The smallest value between
@@ -198,6 +205,7 @@ cannyEdges threshold1 threshold2 aperture img =
     fst . withCompatibleImage img $ \dst -> 
         withHIplImage img $ \src -> 
             cvCanny src dst threshold1 threshold2 aperture
+{-# INLINE [0] cannyEdges #-}
 
 unsafeCanny :: HasDepth d =>
                Double -> Double -> Int -> HIplImage MonoChromatic d -> 
@@ -205,9 +213,13 @@ unsafeCanny :: HasDepth d =>
 unsafeCanny threshold1 threshold2 aperture img = 
     withHIplImage img $ \src -> 
         cvCanny src src threshold1 threshold2 aperture >> return img
+{-# INLINE [0] unsafeCanny #-}
 
-{-# RULES "canny/in-place" forall t1 t2 a.
+{-# RULES 
+"canny/in-place" [~1] forall t1 t2 a.
   cannyEdges t1 t2 a = pipeline (unsafeCanny t1 t2 a)
+"canny/unpipe" [1] forall t1 t2 a.
+  pipeline (unsafeCanny t1 t2 a) = cannyEdges t1 t2 a
   #-}
 
 {-
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 8c13be5..ece5fe4 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, 
-             MultiParamTypeClasses #-}
+             MultiParamTypeClasses, FlexibleInstances #-}
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when composed with a producer of
 -- fresh images.
@@ -7,7 +7,7 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdTruncate, 
                                thresholdToZero, thresholdToZeroInv,
                                thresholdBinaryOtsu, thresholdBinaryOtsuInv,
-                               thresholdTruncateOtsu, 
+                               thresholdTruncateOtsu, unsafeThreshBin,
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
 import Data.Bits ((.|.))
 import Data.Word (Word8)
@@ -31,8 +31,7 @@ data ThresholdType = ThreshBinary
 -- to 8-bit images during the thresholding process.
 class (HasDepth d1, HasDepth d2) => SameOrByte d1 d2 where
 instance SameOrByte Float Word8 where
-instance SameOrByte Float Float where
-instance SameOrByte Word8 Word8 where
+instance ByteOrFloat d => SameOrByte d d where
 
 foreign import ccall unsafe "opencv/cv.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
@@ -77,13 +76,6 @@ unsafeCvThreshold1 :: ByteOrFloat d1 =>
                       IO (HIplImage MonoChromatic d1)
 unsafeCvThreshold1 th mv tt = fmap fst . unsafeCvThreshold th mv tt
 
-{-# RULES 
-"cvThreshold1/in-place" forall t mv tt.
-  cvThreshold1 t mv tt = pipeline (unsafeCvThreshold1 t mv tt)
-"cvThreshold/in-place" forall t mv tt.
-  cvThreshold t mv tt = pipeline (unsafeCvThreshold t mv tt)
-  #-}
-
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
 cvThresholdOtsu :: Word8 -> Int -> HIplImage MonoChromatic Word8 ->
@@ -107,6 +99,7 @@ thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
+{-# INLINE [0] thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
 -- the @maxValue@ passing pixels are mapped to, and the source
@@ -123,6 +116,7 @@ unsafeThreshBin :: ByteOrFloat d =>
                    IO (HIplImage MonoChromatic d)
 unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinary
+{-# INLINE [0] unsafeThreshBin #-}
 
 unsafeThreshBinInv :: ByteOrFloat d =>
                       d -> d -> HIplImage MonoChromatic d ->
@@ -130,11 +124,16 @@ unsafeThreshBinInv :: ByteOrFloat d =>
 unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
+
 {-# RULES 
-"thresholdBinary/in-place" forall th mv. 
+"thresholdBinary/in-place" [~1] forall th mv.
   thresholdBinary th mv = pipeline (unsafeThreshBin th mv)
-"thresholdBinaryInv/in-place" forall th mv. 
+"thresholdBinary/unpipe" [1] forall th mv.
+  pipeline (unsafeThreshBin th mv) = thresholdBinary th mv
+"thresholdBinaryInv/in-place" [~1] forall th mv. 
   thresholdBinaryInv th mv = pipeline (unsafeThreshBinInv th mv)
+"thresholdBinaryInv/unpipe" [1] forall th mv.
+  pipeline (unsafeThreshBinInv th mv) = thresholdBinaryInv th mv
   #-}
 
 -- |Truncation thresholding (i.e. clamping). Parameters are the
@@ -151,8 +150,13 @@ unsafeThreshTrunc :: ByteOrFloat d1 =>
                      IO (HIplImage MonoChromatic d1)
 unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncate/in-place" forall th. 
+{-# INLINE [0] thresholdTruncate #-}
+{-# INLINE [0] unsafeThreshTrunc #-}
+{-# RULES 
+"thresholdTruncate/in-place" [~1] forall th. 
   thresholdTruncate th = pipeline (unsafeThreshTrunc th)
+"thresholdTruncate/unpipe" [1] forall th.
+  pipeline (unsafeThreshTrunc th) = thresholdTruncate th
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
@@ -184,16 +188,21 @@ unsafeThresholdToZeroInv :: ByteOrFloat d =>
 unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
     where tType = fromEnum ThreshToZeroInv
 
-
-{-# RULES "thresholdToZero/in-place" forall th. 
+{-# INLINE [0] thresholdToZero #-}
+{-# INLINE [0] unsafeThresholdToZero #-}
+{-# INLINE [0] thresholdToZeroInv #-}
+{-# INLINE [0] unsafeThresholdToZeroInv #-}
+{-# RULES 
+"thresholdToZero/in-place" [~1] forall th. 
   thresholdToZero th = pipeline (unsafeThresholdToZero th)
-  #-}
-
-{-# RULES "thresholdToZeroInv/in-place" forall th. 
+"thresholdToZero/unpipe" [1] forall th.
+  pipeline (unsafeThresholdToZero th) = thresholdToZero th
+"thresholdToZeroInv/in-place" [~1] forall th. 
   thresholdToZeroInv th = pipeline (unsafeThresholdToZeroInv th)
+"thresholdToZeroInv/unpipe" [1] forall th.
+  pipeline (unsafeThresholdToZeroInv th) = thresholdToZeroInv th
   #-}
 
-
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
@@ -223,15 +232,21 @@ unsafeBinOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
 unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
-
+{-# INLINE [0] thresholdBinaryOtsu #-}
+{-# INLINE [0] unsafeBinOtsu #-}
+{-# INLINE [0] thresholdBinaryOtsuInv #-}
+{-# INLINE [0] unsafeBinOtsuInv #-}
 {-# RULES 
-"thresholdBinaryOtsu/in-place" forall mv. 
+"thresholdBinaryOtsu/in-place" [~1] forall mv. 
   thresholdBinaryOtsu mv = pipeline (unsafeBinOtsu mv)
-"thresholdBinaryOtsuInv/in-place" forall mv. 
+"thresholdBinaryOtsu/unpipe" [1] forall mv.
+  pipeline (unsafeBinOtsu mv) = thresholdBinaryOtsu mv
+"thresholdBinaryOtsuInv/in-place" [~1] forall mv. 
   thresholdBinaryOtsuInv mv = pipeline (unsafeBinOtsuInv mv)
+"thresholdBinaryOtsuInv/unpipe" [1] forall mv.
+  pipeline (unsafeBinOtsuInv mv) = thresholdBinaryOtsuInv mv
   #-}
 
-
 -- |Maps pixels that are greater than @threshold@ to the @threshold@
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
@@ -244,8 +259,13 @@ unsafeTruncOtsu :: HIplImage MonoChromatic Word8 ->
                    IO (HIplImage MonoChromatic Word8, Word8)
 unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
 
-{-# RULES "thresholdTruncateOtsu/in-place" 
+{-# INLINE [0] thresholdTruncateOtsu #-}
+{-# INLINE [0] unsafeTruncOtsu #-}
+{-# RULES 
+"thresholdTruncateOtsu/in-place" [~1] 
   thresholdTruncateOtsu = pipeline unsafeTruncOtsu
+"thresholdTruncateOtsu/unpipe" [1]
+  pipeline unsafeTruncOtsu = thresholdTruncateOtsu
   #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
@@ -272,9 +292,17 @@ unsafeToZeroOtsuInv :: HIplImage MonoChromatic Word8 ->
 unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
     where tType = fromEnum ThreshToZeroInv
 
+{-# INLINE [0] thresholdToZeroOtsu #-}
+{-# INLINE [0] unsafeToZeroOtsu #-}
+{-# INLINE [0] thresholdToZeroOtsuInv #-}
+{-# INLINE [0] unsafeToZeroOtsuInv #-}
 {-# RULES 
-"thresholdToZeroOtsu/in-place" 
+"thresholdToZeroOtsu/in-place" [~1]
   thresholdToZeroOtsu = pipeline unsafeToZeroOtsu
-"thresholdToZeroOtsuInv/in-place"
+"thresholdToZeroOtsu/unpipe" [1]
+  pipeline unsafeToZeroOtsu = thresholdToZeroOtsu
+"thresholdToZeroOtsuInv/in-place" [~1]
   thresholdToZeroOtsuInv = pipeline unsafeToZeroOtsuInv
+"thresholdToZeroOtsuInv/unpipe" [1]
+  pipeline unsafeToZeroOtsuInv = thresholdToZeroOtsuInv
   #-}

From dc7b92e8963666f6322a47609dddb0a5043059b4 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 2 Sep 2010 15:19:54 -0400
Subject: [PATCH 056/137] Tweaked INLINE phase for thresholdBinary.

---
 src/AI/CV/OpenCV/Threshold.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index ece5fe4..278ada2 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -99,7 +99,7 @@ thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
-{-# INLINE [0] thresholdBinary #-}
+{-# INLINE [1] thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
 -- the @maxValue@ passing pixels are mapped to, and the source
@@ -116,7 +116,7 @@ unsafeThreshBin :: ByteOrFloat d =>
                    IO (HIplImage MonoChromatic d)
 unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinary
-{-# INLINE [0] unsafeThreshBin #-}
+{-# INLINE [1] unsafeThreshBin #-}
 
 unsafeThreshBinInv :: ByteOrFloat d =>
                       d -> d -> HIplImage MonoChromatic d ->
@@ -124,7 +124,6 @@ unsafeThreshBinInv :: ByteOrFloat d =>
 unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 
-
 {-# RULES 
 "thresholdBinary/in-place" [~1] forall th mv.
   thresholdBinary th mv = pipeline (unsafeThreshBin th mv)

From f55d39dcdaaa3f03d92d4ef41a3196ec87568f57 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 3 Sep 2010 22:11:30 -0400
Subject: [PATCH 057/137] Added the floodFill function.

---
 HOpenCV.cabal                  |  1 +
 src/AI/CV/OpenCV/FloodFill.hsc | 78 ++++++++++++++++++++++++++++++++++
 src/AI/CV/OpenCV/HighCV.hs     |  4 +-
 3 files changed, 82 insertions(+), 1 deletion(-)
 create mode 100644 src/AI/CV/OpenCV/FloodFill.hsc

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 90b9729..5da2795 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -35,6 +35,7 @@ library
       AI.CV.OpenCV.Core.HIplUtils
       AI.CV.OpenCV.Core.ColorConversion
       AI.CV.OpenCV.HighCV
+      AI.CV.OpenCV.FloodFill
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
       AI.CV.OpenCV.Motion
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
new file mode 100644
index 0000000..85e1d39
--- /dev/null
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -0,0 +1,78 @@
+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}
+-- |Miscellaneous image transformations.
+module AI.CV.OpenCV.FloodFill (floodFill, FloodRange(..)) where
+import Data.Bits ((.|.))
+import Foreign.C.Types (CDouble, CInt)
+import Foreign.Ptr (Ptr, nullPtr, castPtr)
+import AI.CV.OpenCV.Core.CxCore 
+import AI.CV.OpenCV.Core.HIplUtils
+
+-- |Flag used to indicate whether pixels under consideration for
+-- addition to a connected component should be compared to the seed
+-- pixel of the component or their neighbors. Comparing to the seed
+-- pixel leads to a component with a /fixed/ range, while comparing to
+-- neighbors leads to a /floating/ range.
+data FloodRange = FloodFixed | FloodFloating
+
+#include <opencv/cv.h>
+
+foreign import ccall unsafe "opencv/cv.h cvFloodFill"
+  c_cvFloodFill :: Ptr CvArr -> CInt -> CInt -> 
+                   CDouble -> CDouble -> CDouble -> CDouble ->
+                   CDouble -> CDouble -> CDouble -> CDouble ->
+                   CDouble -> CDouble -> CDouble -> CDouble ->
+                   Ptr () -> CInt -> Ptr () -> IO ()
+
+type CvD = (CDouble, CDouble, CDouble, CDouble)
+
+floodHelper :: (Int, Int) -> CvD -> CvD -> CvD -> FloodRange -> 
+               Ptr IplImage -> IO ()
+floodHelper (x,y) newVal loDiff upDiff range src =
+    c_cvFloodFill (castPtr src) (fromIntegral x) (fromIntegral y) 
+                  nv1 nv2 nv3 nv4 lo1 lo2 lo3 lo4 up1 up2 up3 up4 
+                  nullPtr flags nullPtr
+    where (nv1,nv2,nv3,nv4) = newVal
+          (lo1,lo2,lo3,lo4) = loDiff
+          (up1,up2,up3,up4) = upDiff
+          flags = case range of
+                    FloodFixed -> 4 .|. #{const CV_FLOODFILL_FIXED_RANGE}
+                    FloodFloating -> 4
+
+-- |Fills a connected component with the given color. Parameters are
+-- the starting point (x,y) coordinates; the new value of the
+-- repainted pixels; the maximal lower brigtness/color difference
+-- between the currently observed pixel and one of its neighbors
+-- belonging to the component, or the seed pixel; the maximal upper
+-- brightness/color difference between the currently observed pixel
+-- and one of its neighbors belonging to teh component, or the seed
+-- pixel; a flag indicating whether pixels under consideration for
+-- painting should be compared to the seed pixel ('FloodFixed') or to
+-- their neighbors ('FloodFloating'); the source image.
+floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
+              IsCvScalar s, s ~ CvScalar c d) => 
+             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
+             HIplImage c d
+floodFill seed newVal loDiff upDiff range src = 
+    fst . withDuplicateImage src $ \ptr ->
+        floodHelper seed (toCvScalar newVal) (toCvScalar loDiff) 
+                    (toCvScalar upDiff) range ptr
+
+unsafeFlood :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
+                IsCvScalar s, s ~ CvScalar c d) => 
+               (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
+               IO (HIplImage c d)
+unsafeFlood seed newVal loDiff upDiff range src = 
+    withHIplImage src $ \ptr ->
+        do floodHelper seed (toCvScalar newVal) (toCvScalar loDiff) 
+                       (toCvScalar upDiff) range ptr
+           return src
+
+{-# INLINE [1] floodFill #-}
+{-# INLINE [1] unsafeFlood #-}
+
+{-# RULES 
+"floodFill/in-place" [~1] forall s nv ld ud r.
+  floodFill s nv ld ud r = pipeline (unsafeFlood s nv ld ud r)
+"floodFill/unpipe" [1] forall s nv ld ud r.
+  pipeline (unsafeFlood s nv ld ud r) = floodFill s nv ld ud r
+  #-}
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 480b0ed..9466232 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -14,7 +14,8 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             TriChromatic, createVideoWriter, HasChannels,
                             module AI.CV.OpenCV.ColorConversion, GrayImage,
                             ColorImage, createFileCaptureLoop, 
-                            module AI.CV.OpenCV.Threshold)
+                            module AI.CV.OpenCV.Threshold,
+                            module AI.CV.OpenCV.FloodFill)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
@@ -32,6 +33,7 @@ import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
 import Unsafe.Coerce
 import AI.CV.OpenCV.Threshold
+import AI.CV.OpenCV.FloodFill
 
 -- |Grayscale 8-bit (per-pixel) image type synonym.
 type GrayImage = HIplImage MonoChromatic Word8

From 163abf7c9e12a6042a361999388fbe7cb10f84a4 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 17 Nov 2010 20:44:01 -0500
Subject: [PATCH 058/137] Updated vector version.

---
 HOpenCV.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 5da2795..322cfe5 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -59,5 +59,5 @@ library
                   allocated-processor >= 0.0.1, 
                   vector-space,
                   directory >= 1.0.1.0 && < 1.1,
-                  vector >= 0.6.0.2 && < 0.7
+                  vector == 0.7.*
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing

From c43abccfefd487310cf0207325c32c2a3dcce05d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 17 Dec 2010 13:11:19 -0500
Subject: [PATCH 059/137] Updated cvHaarDetectObjects wrapper for OpenCV 2.2

---
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index caa0c7b..fcb3431 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -165,8 +165,9 @@ CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,
                               CvMemStorage* storage, double scale_factor,
                               int min_neighbors , int flags,
-                              int width, int height)
+                              int min_width, int min_height,
+                              int max_width, int max_height)
 {
-    return cvHaarDetectObjects(image, cascade, storage, scale_factor, min_neighbors, flags, cvSize(width, height));
+    return cvHaarDetectObjects(image, cascade, storage, scale_factor, min_neighbors, flags, cvSize(min_width, min_height), cvSize(max_width, max_height));
 }
 

From 578b83f700dd955f3bf12db5506158863d2e5f17 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 4 Feb 2011 19:29:55 -0500
Subject: [PATCH 060/137] Updates to OpenCV 2.2 support with new split header
 files. Added windowing support (this requires SDL wrapping on Mac OS X).
 Fixed image file loading color support.

---
 HOpenCV.cabal                             |   3 +-
 src/AI/CV/OpenCV/Core/CV.hsc              |  29 ++---
 src/AI/CV/OpenCV/Core/ColorConversion.hsc |   2 +-
 src/AI/CV/OpenCV/Core/CxCore.hsc          |  16 +--
 src/AI/CV/OpenCV/Core/HIplImage.hsc       |   2 +-
 src/AI/CV/OpenCV/Core/HIplUtils.hs        |   2 +-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c      |  10 +-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h      |   4 +-
 src/AI/CV/OpenCV/Core/HighGui.hsc         | 124 ++++++++++++++++++----
 src/AI/CV/OpenCV/GUI.hs                   |  29 +++++
 10 files changed, 169 insertions(+), 52 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/GUI.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 322cfe5..3764ba0 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -8,7 +8,7 @@ category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
 Tested-With:   GHC==6.12.1, GHC==6.12.3
 description:
-   Limited bindings to OpenCV 2.1. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
+   Limited bindings to OpenCV 2.2. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
    /Installation/
    .
@@ -35,6 +35,7 @@ library
       AI.CV.OpenCV.Core.HIplUtils
       AI.CV.OpenCV.Core.ColorConversion
       AI.CV.OpenCV.HighCV
+      AI.CV.OpenCV.GUI
       AI.CV.OpenCV.FloodFill
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
index e6ef461..6aa050f 100644
--- a/src/AI/CV/OpenCV/Core/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -3,10 +3,10 @@
 module AI.CV.OpenCV.Core.CV 
     ( InterpolationMethod(..),
       cvCanny, cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
-      CvHaarClassifierCascade, HaarDetectFlag,
-      cvHaarFlagNone, cvHaarDoCannyPruning, 
-      cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
-      combineHaarFlags, cvHaarDetectObjects,
+      --CvHaarClassifierCascade, HaarDetectFlag,
+      --cvHaarFlagNone, cvHaarDoCannyPruning, 
+      --cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
+      --combineHaarFlags, cvHaarDetectObjects,
       cvCvtColor,
       cvSampleLine, Connectivity(..)
     ) where
@@ -16,13 +16,13 @@ import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Marshal.Array (peekArray)
 import Foreign.Storable (Storable, sizeOf)
 import Foreign.Ptr
-import Data.Bits
+--import Data.Bits
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.ColorConversion
 
 #include <opencv/cv.h>
 
-foreign import ccall unsafe "opencv/cv.h cvCanny"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCanny"
   c_cvCanny :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> IO ()
 
 -- Canny 
@@ -39,13 +39,13 @@ data InterpolationMethod = CV_INTER_NN
                          | CV_INTER_AREA
                            deriving (Enum,Eq)
 
-foreign import ccall unsafe "opencv/cv.h cvResize"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvResize"
   c_cvResize :: Ptr CvArr -> Ptr CvArr -> 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)
 
-foreign import ccall unsafe "opencv/cv.h cvDilate"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvDilate"
   c_dilate :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
 -- |Dilate the first image using a 3x3 rectangular structuring element
@@ -54,7 +54,7 @@ foreign import ccall unsafe "opencv/cv.h cvDilate"
 cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2  -> CInt -> IO ()
 cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) nullPtr iter
 
-foreign import ccall unsafe "opencv/cv.h cvErode"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvErode"
   c_erode :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
 -- |Erode the first image using a 3x3 rectangular structuring element
@@ -63,7 +63,7 @@ foreign import ccall unsafe "opencv/cv.h cvErode"
 cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
 cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
 
-foreign import ccall unsafe "opencv/cv.h cvHoughLines2"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvHoughLines2"
         c_cvHoughLines2 :: Ptr CvArr -> Ptr CvMemStorage -> CInt -> CDouble -> CDouble -> CInt -> CDouble -> CDouble -> IO (Ptr (CvSeq a))
 
 cvHoughLines2 :: IplArrayType i => Ptr i -> Ptr CvMemStorage -> CInt -> Double -> Double -> Int -> Double -> Double -> IO (Ptr (CvSeq a))
@@ -72,10 +72,10 @@ cvHoughLines2 img storage method rho theta threshold param1 param2 =
                     (realToFrac theta) (fromIntegral threshold) 
                     (realToFrac param1) (realToFrac param2)
 
-foreign import ccall unsafe "opencv/cv.h cvCvtColor"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCvtColor"
   c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
-foreign import ccall unsafe "opencv/cv.h cvSampleLine"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSampleLine"
   c_cvSampleLine :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> Ptr a -> 
                     CInt -> IO CInt
 
@@ -108,7 +108,7 @@ cvCvtColor :: (IplArrayType a, IplArrayType b) =>
               Ptr a -> Ptr b -> ColorConversion -> IO ()
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
-foreign import ccall unsafe "opencv/cv.h cvPyrDown"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 -- for now only one filter type is supported so no need for the CInt (filter type)
@@ -118,7 +118,7 @@ cvPyrDown :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> IO ()
 cvPyrDown src dst = c_cvPyrDown (fromArr src) (fromArr dst) constCvGaussian5x5
 
 ------------------------------------------------------------------------------
-
+{-
 data CvHaarClassifierCascade
 
 -- thanks to http://book.realworldhaskell.org/read/interfacing-with-c-the-ffi.html
@@ -158,3 +158,4 @@ cvHaarDetectObjects :: (IplArrayType i) =>
 cvHaarDetectObjects image cascade storage scaleFactor minNeighbors flags minSize = 
   c_cvHaarDetectObjects (fromArr image) cascade storage scaleFactor minNeighbors (unHaarDetectFlag flags) (sizeWidth minSize) (sizeHeight minSize)
   
+-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/ColorConversion.hsc b/src/AI/CV/OpenCV/Core/ColorConversion.hsc
index d346840..f7fbc48 100644
--- a/src/AI/CV/OpenCV/Core/ColorConversion.hsc
+++ b/src/AI/CV/OpenCV/Core/ColorConversion.hsc
@@ -2,7 +2,7 @@
 module AI.CV.OpenCV.Core.ColorConversion where
 import Foreign.C.Types (CInt)
 
-#include <opencv/cv.h>
+#include <opencv2/imgproc/imgproc_c.h>
 
 newtype ColorConversion = ColorConversion { colorConv :: CInt } deriving Eq
 
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index c86c6ab..6064bb2 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -12,7 +12,7 @@ import System.IO.Unsafe (unsafePerformIO)
 
 import Data.VectorSpace as VectorSpace
 
-#include <opencv/cxcore.h>
+#include <opencv2/core/core_c.h>
 
 ------------------------------------------------------
 toFromIntegral :: (RealFrac c, Integral b, Integral a, Num b1) => (b1 -> c) -> a -> b
@@ -146,7 +146,7 @@ numToDepth x = lookup x depthsLookupList
 
 ---------------------------------------------------------------
 -- mem storage
-foreign import ccall unsafe "opencv/cxcore.h cvCreateMemStorage"
+foreign import ccall unsafe "opencv2/core/core_.h cvCreateMemStorage"
   c_cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage)
 
 cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage)
@@ -155,7 +155,7 @@ cvCreateMemStorage = errorName "Failed to create mem storage" . checkPtr . c_cvC
 -- foreign import ccall unsafe "HOpenCV_wrap.h release_mem_storage"
 --   cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
 
-foreign import ccall unsafe "opencv/cxcore.h cvReleaseMemStorage"
+foreign import ccall unsafe "opencv2/core/core_c.h cvReleaseMemStorage"
   c_cvReleaseMemStorage :: Ptr (Ptr CvMemStorage) -> IO ()
 
 cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
@@ -181,7 +181,7 @@ cvCreateImage size numChans depth =
 
 -- foreign import ccall unsafe "HOpenCV_wrap.h release_image"
 --   cvReleaseImage :: Ptr IplImage -> IO ()
-foreign import ccall unsafe "opencv/cxcore.h cvReleaseImage"
+foreign import ccall unsafe "opencv2/core/core_c.h cvReleaseImage"
   c_cvReleaseImage :: Ptr (Ptr IplImage) -> IO ()
 
 -- |Release the memory allocated to an 'IplImage'.
@@ -194,7 +194,7 @@ foreign import ccall unsafe "HOpenCV_wrap.h &release_image"
 createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage)
 createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z
 
-foreign import ccall unsafe "opencv/cxcore.h cvCloneImage"
+foreign import ccall unsafe "opencv2/core/core_c.h cvCloneImage"
   c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
 
 cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
@@ -206,7 +206,7 @@ cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x
 foreign import ccall unsafe "HOpenCV_wrap.h get_size"
   c_get_size :: Ptr CvArr -> Ptr CvSize -> IO ()
 
-foreign import ccall unsafe "opencv/cxcore.h cvCopy"
+foreign import ccall unsafe "opencv2/core/core_c.h cvCopy"
   c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
                    
 -- todo add mask support
@@ -243,7 +243,7 @@ foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
 foreign import ccall unsafe "HOpenCV_wrap.h cv_free"
   cvFree :: Ptr a -> IO ()
             
-foreign import ccall unsafe "opencv/cxcore.h cvLoad"
+foreign import ccall unsafe "opencv2/core/core_c.h cvLoad"
   c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a)
 
 cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String)
@@ -261,7 +261,7 @@ cvLoad filename memstorage name = withCString filename cvLoad'
               cvFree realNameC
               return (ptrObj, realName)
               
-foreign import ccall unsafe "opencv/cxcore.h cvGetSeqElem"
+foreign import ccall unsafe "opencv2/core/core_c.h cvGetSeqElem"
   cvGetSeqElem :: Ptr (CvSeq a) -> CInt -> IO (Ptr a)
   
 -- foreign import ccall unsafe "HOpenCV_wrap.h c_rect_cvGetSeqElem"
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index a6abad2..20ee714 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -19,7 +19,7 @@ import Foreign.Ptr
 import Foreign.Storable
 import Unsafe.Coerce
 
-#include <opencv/cxtypes.h>
+#include <opencv2/core/types_c.h>
 {-
 typedef struct _IplImage
 {
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 8905e1d..d0b4140 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -9,7 +9,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      withDuplicateImage, withCompatibleImage, pipeline,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
-     HasDepth(..), HasScalar(..), IsCvScalar(..),
+     HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getROI) where
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index fcb3431..9c2b29d 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -1,6 +1,6 @@
-#include <opencv/cxcore.h>
-#include <opencv/cv.h>
-#include <opencv/highgui.h>
+#include <opencv2/core/core_c.h>
+#include <opencv2/imgproc/imgproc_c.h>
+#include <opencv2/highgui/highgui_c.h>
 
 #include <stdio.h>
 
@@ -160,7 +160,7 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
 
 
 /****************************************************************************/
-
+/*
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,
                               CvMemStorage* storage, double scale_factor,
@@ -170,4 +170,4 @@ CvSeq *c_cvHaarDetectObjects( const CvArr* image,
 {
     return cvHaarDetectObjects(image, cascade, storage, scale_factor, min_neighbors, flags, cvSize(min_width, min_height), cvSize(max_width, max_height));
 }
-
+*/
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 484effb..5108abc 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -1,5 +1,5 @@
-#include <opencv/cv.h>
-#include <opencv/cxcore.h>
+#include <opencv2/imgproc/imgproc_c.h>
+#include <opencv2/core/core_c.h>
 
 void debug_print_image_header(IplImage *image);
 
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
index 4928a4c..12e5277 100644
--- a/src/AI/CV/OpenCV/Core/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -5,24 +5,28 @@ module AI.CV.OpenCV.Core.HighGui
      createCameraCaptureF, createFileCaptureF,
      cvCreateFileCapture, setCapturePos, 
      CapturePos(..), cvQueryFrame,
-     newWindow, delWindow, showImage, waitKey,
+     newWindow, delWindow, showImage, cvWaitKey,
      cvConvertImage, c_debug_ipl,
-     createVideoWriterF, cvWriteFrame, FourCC) where
+     createVideoWriterF, cvWriteFrame, FourCC,
+     cvNamedWindow, cvDestroyWindow, cvShowImage, WindowFlag(..),
+     MouseCallback, cvSetMouseCallback, wrapMouseCB, cvInit,
+     windowFlagsToEnum, Event(..), EventFlag(..)) where
 
-import Data.Bits ((.&.), shiftL) 
+import Data.Bits ((.&.), (.|.), shiftL) 
 import Foreign.ForeignPtrWrap
 import Foreign.C.Types
 import Foreign.Ptr
 import Foreign.ForeignPtr
 import Foreign.C.String
- 
+
+import Data.List (foldl') 
 import AI.CV.OpenCV.Core.CxCore
 
-#include <opencv/highgui.h>
+#include <opencv2/highgui/highgui_c.h>
 
 ------------------------------------------------
 -- General
-foreign import ccall unsafe "highgui.h cvConvertImage"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvConvertImage"
   c_cvConvertImage :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 cvConvertImage :: (IplArrayType a, IplArrayType a1) => Ptr a -> Ptr a1 -> CInt -> IO ()
@@ -32,20 +36,27 @@ cvConvertImage src dst flags = c_cvConvertImage (fromArr src) (fromArr dst) flag
 data LoadColor = LoadColor     -- ^Force a 3-channel color image
                | LoadGray      -- ^Force a grayscale image
                | LoadUnchanged -- ^Load the image as is
-                 deriving Enum
 
-foreign import ccall unsafe "highgui.h cvLoadImage"
+instance Enum LoadColor where
+  fromEnum LoadColor                      = (#const CV_LOAD_IMAGE_COLOR)
+  fromEnum LoadGray                       = (#const CV_LOAD_IMAGE_GRAYSCALE)
+  fromEnum LoadUnchanged                  = (#const CV_LOAD_IMAGE_UNCHANGED)
+  toEnum (#const CV_LOAD_IMAGE_COLOR)     = LoadColor
+  toEnum (#const CV_LOAD_IMAGE_GRAYSCALE) = LoadGray
+  toEnum (#const CV_LOAD_IMAGE_UNCHANGED) = LoadUnchanged
+  toEnum x = error $ "Unknown LoadColor enum "++show x
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvLoadImage"
   c_cvLoadImage :: CString -> CInt -> IO (Ptr IplImage)
 
 cvLoadImage :: String -> LoadColor -> IO (Ptr IplImage)
-cvLoadImage fileName col = withCString fileName $ 
-                           \str -> c_cvLoadImage str col'
+cvLoadImage fileName col = withCString fileName (flip c_cvLoadImage col')
     where col' = fromIntegral $ fromEnum col
 
 foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header"
   c_debug_ipl :: Ptr IplImage -> IO ()
 
-foreign import ccall safe "highgui.h cvSaveImage"
+foreign import ccall safe "opencv2/highgui/highgui_c.h cvSaveImage"
   c_cvSaveImage :: CString -> Ptr CvArr -> Ptr Int -> IO ()
 
 cvSaveImage :: IplArrayType a => String -> Ptr a -> IO ()
@@ -57,14 +68,14 @@ cvSaveImage fileName img = withCString fileName $
 data CvCapture
 
 
-foreign import ccall unsafe "highgui.h cvCreateCameraCapture"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateCameraCapture"
   c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
                           
 cvCreateCameraCapture :: Int -> IO (Ptr CvCapture)
 cvCreateCameraCapture = errorName "Failed to create camera" . checkPtr . 
                         c_cvCreateCameraCapture . fromIntegral
   
-foreign import ccall unsafe "highgui.h cvCreateFileCapture"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateFileCapture"
   c_cvCreateFileCapture :: CString -> IO (Ptr CvCapture)
                           
 cvCreateFileCapture :: String -> IO (Ptr CvCapture)
@@ -72,7 +83,7 @@ cvCreateFileCapture filename = err' . checkPtr $
                                withCString filename c_cvCreateFileCapture
     where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'"
 
-foreign import ccall unsafe "highgui.h cvSetCaptureProperty"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvSetCaptureProperty"
   c_cvSetCaptureProperty :: Ptr CvCapture -> CInt -> CDouble -> IO ()
 
 -- |The current position of a video capture.
@@ -104,7 +115,7 @@ createCameraCaptureF = createForeignPtr cp_release_capture . cvCreateCameraCaptu
 createFileCaptureF :: String -> IO (ForeignPtr CvCapture)
 createFileCaptureF = createForeignPtr cp_release_capture . cvCreateFileCapture
 
-foreign import ccall unsafe "highgui.h cvQueryFrame"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
 
 cvQueryFrame :: Ptr CvCapture -> IO (Maybe (Ptr IplImage))
@@ -119,7 +130,7 @@ fourCC (a,b,c,d) = (c1 .&. 255) + shiftL (c2 .&. 255) 8 +
                    shiftL (c3 .&. 255) 16 + shiftL (c4 .&. 255) 24
     where [c1,c2,c3,c4] = map (fromIntegral . fromEnum) [a,b,c,d]
 
-foreign import ccall unsafe "highgui.h cvCreateVideoWriter"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateVideoWriter"
   c_cvCreateVideoWriter :: CString -> CInt -> CDouble -> CInt -> CInt -> CInt ->
                            IO (Ptr CvVideoWriter)
 
@@ -139,7 +150,7 @@ createVideoWriterF :: FilePath -> FourCC -> Double -> (Int, Int) ->
 createVideoWriterF fname codec fps sz = createForeignPtr cp_release_writer $
                                         cvCreateVideoWriter fname codec fps sz
 
-foreign import ccall unsafe "highgui.h cvWriteFrame"
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvWriteFrame"
   cvWriteFrame :: Ptr CvVideoWriter -> Ptr IplImage -> IO ()
 
 -------------------------------------------------
@@ -156,5 +167,80 @@ foreign import ccall unsafe "HOpenCV_wrap.h del_window"
 foreign import ccall unsafe "HOpenCV_wrap.h show_image"
   showImage :: CInt -> Ptr IplImage -> IO ()
 
-foreign import ccall unsafe "highgui.h cvWaitKey"
-  waitKey :: CInt -> IO CInt
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvWaitKey"
+  cvWaitKey :: CInt -> IO CInt
+
+-- New Windowing Code
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvInitSystem"
+  cvInitSystem :: CInt -> Ptr CString -> IO ()
+
+cvInit :: IO ()
+cvInit = cvInitSystem 0 nullPtr
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvNamedWindow"
+  cvNamedWindow :: CString -> CInt -> IO ()
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvDestroyWindow"
+  cvDestroyWindow :: CString -> IO ()
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvShowImage"
+  cvShowImage :: CString -> Ptr CvArr -> IO ()
+
+type CMouseCallback = CInt -> CInt -> CInt -> CInt -> Ptr () -> IO ()
+
+foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvSetMouseCallback"
+  cvSetMouseCallback :: CString -> FunPtr CMouseCallback -> Ptr () -> IO ()
+
+foreign import ccall "wrapper"
+  mkMouseCB :: CMouseCallback -> IO (FunPtr CMouseCallback)
+
+data WindowFlag = AutoSize
+
+windowFlagToEnum :: WindowFlag -> CInt
+windowFlagToEnum AutoSize = #{const CV_WINDOW_AUTOSIZE}
+
+windowFlagsToEnum :: [WindowFlag] -> CInt
+windowFlagsToEnum = foldl' (.|.) 0 . map windowFlagToEnum
+
+data Event = MouseMove | LButtonDown | RButtonDown | MButtonDown
+           | LButtonUp | RButtonUp | MButtonUp | LButtonDblClk
+           | RButtonDblClk | MButtonDblClk
+
+type MouseCallback = Event -> (Int,Int) -> [EventFlag] -> IO ()
+
+wrapMouseCB :: MouseCallback -> IO (FunPtr CMouseCallback)
+wrapMouseCB cb = mkMouseCB $ 
+                 \e x y f _ -> cb (enumToEvent e) 
+                                  (fromIntegral x, fromIntegral y)
+                                  (enumToEventFlags f)
+                                  
+enumToEvent :: CInt -> Event
+enumToEvent (#const CV_EVENT_MOUSEMOVE)     = MouseMove
+enumToEvent (#const CV_EVENT_LBUTTONDOWN)   = LButtonDown
+enumToEvent (#const CV_EVENT_RBUTTONDOWN)   = RButtonDown
+enumToEvent (#const CV_EVENT_MBUTTONDOWN)   = MButtonDown
+enumToEvent (#const CV_EVENT_LBUTTONUP)     = LButtonUp
+enumToEvent (#const CV_EVENT_RBUTTONUP)     = RButtonUp
+enumToEvent (#const CV_EVENT_MBUTTONUP)     = MButtonUp
+enumToEvent (#const CV_EVENT_LBUTTONDBLCLK) = LButtonDblClk
+enumToEvent (#const CV_EVENT_RBUTTONDBLCLK) = RButtonDblClk
+enumToEvent (#const CV_EVENT_MBUTTONDBLCLK) = MButtonDblClk
+enumToEvent x                               = error $ "Unkonwn event "++show x
+
+data EventFlag = LButton | RButton | MButton | CtrlKey | ShiftKey | AltKey
+                 deriving (Enum, Bounded)
+
+eventFlagToEnum :: EventFlag -> CInt
+eventFlagToEnum LButton  = (#const CV_EVENT_FLAG_LBUTTON)
+eventFlagToEnum RButton  = (#const CV_EVENT_FLAG_RBUTTON)
+eventFlagToEnum MButton  = (#const CV_EVENT_FLAG_MBUTTON)
+eventFlagToEnum CtrlKey  = (#const CV_EVENT_FLAG_CTRLKEY)
+eventFlagToEnum ShiftKey = (#const CV_EVENT_FLAG_SHIFTKEY)
+eventFlagToEnum AltKey   = (#const CV_EVENT_FLAG_ALTKEY)
+
+enumToEventFlags :: CInt -> [EventFlag]
+enumToEventFlags x = map fst . filter snd $
+                     zip [minBound..maxBound]
+                         (map ((> 0) . (x .|.)) 
+                              (map eventFlagToEnum [minBound..maxBound]))
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
new file mode 100644
index 0000000..f8184e2
--- /dev/null
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -0,0 +1,29 @@
+module AI.CV.OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
+                         waitKey, cvInit) where
+import Control.Concurrent (forkIO, killThread, Chan, readChan)
+import Control.Monad (forever, (>=>))
+import AI.CV.OpenCV.Core.HIplImage
+import AI.CV.OpenCV.Core.HighGui
+import AI.CV.OpenCV.Core.CxCore (fromArr)
+import Foreign.C.String (withCString)
+
+-- |Create a new window with the given title. The return value is an
+-- action for destroying the window.
+namedWindow :: (HasChannels c, HasDepth d) => 
+               String -> [WindowFlag] -> Maybe MouseCallback -> 
+               Chan (HIplImage c d) -> IO (IO ())
+namedWindow name flags _cb c = 
+  withCString name $ \s ->
+    do cvNamedWindow s (windowFlagsToEnum flags)
+       t <- forkIO $ forever (readChan c >>= 
+                              flip withHIplImage (cvShowImage s . fromArr) >>
+                              waitKey 1 >> return ())
+       return (killThread t >> cvDestroyWindow s)
+
+-- | @waitKey delay@ waits for a key indifinitely if @delay <= 0@, or
+-- for @delay@ milliseconds. The returned value is the code of the
+-- pressed key or 'Nothing'.
+waitKey :: Int -> IO (Maybe Int)
+waitKey = cvWaitKey . fromIntegral >=> return . checkKey
+  where checkKey (-1) = Nothing
+        checkKey x = Just (fromIntegral x)

From ca4dc652c81aa8980817db0cdf3c854b2d7a5cf0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 4 Feb 2011 19:38:42 -0500
Subject: [PATCH 061/137] Added keyboard callback to namedWindow.

---
 src/AI/CV/OpenCV/GUI.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index f8184e2..666dc54 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -7,18 +7,24 @@ import AI.CV.OpenCV.Core.HighGui
 import AI.CV.OpenCV.Core.CxCore (fromArr)
 import Foreign.C.String (withCString)
 
+type KeyboardCallback = Int -> IO ()
+
 -- |Create a new window with the given title. The return value is an
 -- action for destroying the window.
 namedWindow :: (HasChannels c, HasDepth d) => 
-               String -> [WindowFlag] -> Maybe MouseCallback -> 
+               String -> [WindowFlag] -> 
+               Maybe MouseCallback -> 
+               Maybe KeyboardCallback ->
                Chan (HIplImage c d) -> IO (IO ())
-namedWindow name flags _cb c = 
+namedWindow name flags _cb kcb c = 
   withCString name $ \s ->
     do cvNamedWindow s (windowFlagsToEnum flags)
        t <- forkIO $ forever (readChan c >>= 
                               flip withHIplImage (cvShowImage s . fromArr) >>
-                              waitKey 1 >> return ())
+                              waitKey 1 >>= kbWrap)
        return (killThread t >> cvDestroyWindow s)
+    where kbWrap Nothing = return ()
+          kbWrap (Just x) = maybe (return ()) ($ x) kcb
 
 -- | @waitKey delay@ waits for a key indifinitely if @delay <= 0@, or
 -- for @delay@ milliseconds. The returned value is the code of the

From c84b21773d1f8b07d6d3eaff4e8f4e51d2540de9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 4 Feb 2011 22:15:10 -0500
Subject: [PATCH 062/137] Fixed linking with OpenCV 2.2 libraries. Updated
 several header references. Fixed pokeIpl.

---
 HOpenCV.cabal                        |  2 +-
 src/AI/CV/OpenCV/ArrayOps.hs         | 18 +++++++-------
 src/AI/CV/OpenCV/Contours.hsc        |  2 +-
 src/AI/CV/OpenCV/Core/CxCore.hsc     |  9 ++++++-
 src/AI/CV/OpenCV/Core/HIplImage.hsc  | 21 ++++++++++------
 src/AI/CV/OpenCV/Core/HIplUtils.hs   | 36 ++++++++++++++++------------
 src/AI/CV/OpenCV/FeatureDetection.hs |  2 +-
 src/AI/CV/OpenCV/Filtering.hsc       |  4 ++--
 src/AI/CV/OpenCV/FloodFill.hsc       |  4 ++--
 src/AI/CV/OpenCV/GUI.hs              | 26 +++++++++-----------
 10 files changed, 70 insertions(+), 54 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 3764ba0..32fed74 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -54,7 +54,7 @@ library
      extra-lib-dirs:     C:\\OpenCV2.1\\bin
      extra-libraries: cxcore210, cv210, highgui210
    else
-     extra-libraries: cxcore,cv,highgui
+     extra-libraries: opencv_core,opencv_imgproc,opencv_highgui
    build-depends: base >=4 && <5, 
                   template-haskell,
                   allocated-processor >= 0.0.1, 
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 1f029e9..13c99bd 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -10,7 +10,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
 import AI.CV.OpenCV.Core.HIplUtils
 
-foreign import ccall unsafe "opencv/cxcore.h cvSubRS"
+foreign import ccall unsafe "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -41,7 +41,7 @@ unsafeSubRS value src = withHIplImage src $ \srcPtr ->
 "subRS/unpipe" [1] forall v. pipeline (unsafeSubRS v) = subRS v
   #-}
 
-foreign import ccall unsafe "opencv/cxcore.h cvAbsDiff"
+foreign import ccall unsafe "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
@@ -67,7 +67,7 @@ unsafeAbsDiff src1 src2 = withHIplImage src1 $ \src1' ->
 "absDiff/unpipe" [1] forall m. pipeline (unsafeAbsDiff m) = absDiff m
   #-}
 
-foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
+foreign import ccall unsafe "opencv2/core/core_c.h cvConvertScale"
   c_cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
 
 -- |Converts one array to another with optional affine
@@ -90,7 +90,7 @@ convertScale scale shift src = unsafePerformIO $
                                                        (realToFrac shift)
                                   return dst
 
-foreign import ccall unsafe "opencv/cxcore.h cvAnd"
+foreign import ccall unsafe "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 cvAndHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> 
@@ -144,7 +144,7 @@ unsafeAndMask mask src1 src2 = withHIplImage src1 $ \src1' ->
   pipeline (unsafeAndMask m s) = cvAndMask m s
   #-}
 
-foreign import ccall unsafe "opencv/cxcore.h cvAndS"
+foreign import ccall unsafe "opencv2/core/core_c.h cvAndS"
    c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -170,7 +170,7 @@ unsafeAndS s img = do withHIplImage img $ \src ->
 "cvAndS/unpipe" [1] forall s. pipeline (unsafeAndS s) = cvAndS s
   #-}
 
-foreign import ccall unsafe "opencv/cxcore.h cvScaleAdd"
+foreign import ccall unsafe "opencv2/core/core_c.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                   Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -184,7 +184,7 @@ cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
                                             (castPtr src2') (castPtr dst)
     where (r,g,b,a) = toCvScalar s
 
-foreign import ccall unsafe "opencv/cxcore.h cvMul"
+foreign import ccall unsafe "opencv2/core/core_c.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
 
 cvMulHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
@@ -229,7 +229,7 @@ unsafeMul' scale src1 src2 = do withHIplImage src1 $ \src1' ->
 "cvMul'/unpipe" [1] forall s s1. pipeline (unsafeMul' s s1) = cvMul' s s1
   #-}
 
-foreign import ccall unsafe "opencv/cxcore.h cvAdd"
+foreign import ccall unsafe "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum of two arrays.
@@ -249,7 +249,7 @@ unsafeAdd src1 src2 = do withHIplImage src1 $ \src1' ->
                                      (castPtr src2') nullPtr
                          return src2
 
-foreign import ccall unsafe "opencv/cxcore.h cvAddS"
+foreign import ccall unsafe "opencv2/core/core_c.h cvAddS"
   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
               Ptr CvArr -> Ptr CvArr -> IO ()
 
diff --git a/src/AI/CV/OpenCV/Contours.hsc b/src/AI/CV/OpenCV/Contours.hsc
index 46a3344..4338866 100644
--- a/src/AI/CV/OpenCV/Contours.hsc
+++ b/src/AI/CV/OpenCV/Contours.hsc
@@ -8,7 +8,7 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable
 import Foreign.Marshal.Alloc (alloca)
 
-#include <opencv/cv.h>
+#include <opencv2/core/types_c.h>
 
 foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
   c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> 
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 6064bb2..389ee93 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -112,6 +112,10 @@ instance IplArrayType CvArr
 data IplImage
 instance IplArrayType IplImage
 
+instance Storable IplImage where
+  sizeOf _ = (#size IplImage)
+  alignment _ = alignment (undefined::CDouble)
+
 data CvMemStorage
 
 data CvSeq a
@@ -242,7 +246,10 @@ foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
                                 
 foreign import ccall unsafe "HOpenCV_wrap.h cv_free"
   cvFree :: Ptr a -> IO ()
-            
+
+foreign import ccall unsafe "HOpenCV_wrap.h &cv_free"
+  cvFreePtr :: FunPtr (Ptr a -> IO ())
+
 foreign import ccall unsafe "opencv2/core/core_c.h cvLoad"
   c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a)
 
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 20ee714..5e1cbd1 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -3,9 +3,9 @@
 module AI.CV.OpenCV.Core.HIplImage 
     ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
-      ByteOrFloat, HasScalar(..), IsCvScalar(..)) where
+      ByteOrFloat, HasScalar(..), IsCvScalar(..), freeROI) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
-                                 iplDepth32f, iplDepth64f)
+                                 iplDepth32f, iplDepth64f, cvFree)
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
 import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
@@ -128,6 +128,7 @@ data HIplImage c d = (HasChannels c, HasDepth d) =>
                                , height    :: Int
                                , imageSize :: Int
                                , imageData :: ForeignPtr d
+                               , imageDataOrigin :: ForeignPtr d
                                , widthStep :: Int }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
@@ -136,7 +137,7 @@ mkHIplImage :: forall c d. (HasChannels c, HasDepth d) =>
                Int -> Int -> IO (HIplImage c d)
 mkHIplImage w h = 
     do ptr <- mallocForeignPtrArray numBytes
-       return $ HIplImage 0 w h numBytes ptr stride
+       return $ HIplImage 0 w h numBytes ptr ptr stride
     where numBytes = stride * h
           bpp = bytesPerPixel (undefined::d)
           stride = w * (numChannels (undefined::c) :: Int) * bpp
@@ -161,13 +162,13 @@ withHIplImage :: (HasChannels c, HasDepth d) =>
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
                                            (\hp -> pokeIpl img p (castPtr hp) >>
-                                                   f (castPtr p))
+                                                   f p)
 
--- Poke a 'Ptr' 'HIplImage' with a specific imageData 'Ptr' that is
+-- Poke a 'Ptr' 'IplImage' with a specific imageData 'Ptr' that is
 -- currently valid. This is solely an auxiliary function to
 -- 'withHIplImage'.
 pokeIpl :: forall c d. (HasChannels c, HasDepth d) => 
-           HIplImage c d -> Ptr (HIplImage c d) -> Ptr Word8 -> IO ()
+           HIplImage c d -> Ptr IplImage -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
     do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
        (#poke IplImage, ID) ptr (0::Int)
@@ -187,6 +188,10 @@ pokeIpl himg ptr hp =
        (#poke IplImage, widthStep) ptr (widthStep himg)
        (#poke IplImage, imageDataOrigin) ptr hp
 
+freeROI :: Ptr IplImage -> IO ()
+freeROI ptr = do p <- (#peek IplImage, roi) ptr
+                 if (ptrToIntPtr p == 0) then return () else cvFree p
+
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
 -- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
@@ -218,10 +223,12 @@ instance forall c d. (HasChannels c, HasDepth d) =>
                            else cv_BGR2GRAY
                     ptr' = castPtr ptr :: Ptr IplImage
                 withHIplImage img2 $ \dst -> cvCvtColor ptr' dst conv
+                (#peek IplImage, imageDataOrigin) ptr >>= cvFree
                 return $ unsafeCoerce img2
         else do origin' <- (#peek IplImage, origin) ptr
                 imageSize' <- (#peek IplImage, imageSize) ptr
                 imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
+                imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
                 widthStep' <- (#peek IplImage, widthStep) ptr
                 return $ HIplImage origin' width' height' imageSize' 
-                                   imageData' widthStep'
+                                   imageData' imageDataOrigin' widthStep'
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index d0b4140..c0c432d 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -11,7 +11,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getROI) where
-import AI.CV.OpenCV.Core.CxCore (IplImage)
+import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
 import Control.Monad ((<=<))
@@ -79,18 +79,24 @@ checkFile f = do e <- doesFileExist f
 -- |Load a color 'HIplImage' from an 8-bit image file. If the image
 -- file is grayscale, it will be converted to color.
 fromFileColor :: FilePath -> IO (HIplImage TriChromatic Word8)
-fromFileColor fileName = do checkFile fileName
-                            ptr <- cvLoadImage fileName LoadColor
-                            img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8)
-                            return $ unsafeCoerce img
+fromFileColor fileName = 
+  do checkFile fileName
+     ptr <- cvLoadImage fileName LoadColor
+     img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8)
+     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
+     freeROI ptr
+     cvFree ptr
+     return $ unsafeCoerce img
 
 -- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
 -- image file is color, it will be converted to grayscale.
 fromFileGray :: FilePath -> IO (HIplImage MonoChromatic Word8)
-fromFileGray fileName = do checkFile fileName
-                           ptr <- cvLoadImage fileName LoadGray
-                           img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8)
-                           return $ unsafeCoerce img
+fromFileGray fileName = 
+  do checkFile fileName
+     ptr <- cvLoadImage fileName LoadGray
+     img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8)
+     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
+     return $ unsafeCoerce img
 
 -- |Save a 'HIplImage' to the specified file.
 toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
@@ -101,9 +107,9 @@ toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
 compatibleImage :: HIplImage c d -> IO (HIplImage c d)
-compatibleImage img@(HIplImage _ _ _ _ _ _) = 
+compatibleImage img@(HIplImage _ _ _ _ _ _ _) = 
     do ptr <- mallocForeignPtrArray sz
-       return $ HIplImage 0 w h sz ptr stride
+       return $ HIplImage 0 w h sz ptr ptr stride
     where w = width img
           h = height img
           sz = imageSize img
@@ -112,11 +118,11 @@ compatibleImage img@(HIplImage _ _ _ _ _ _) =
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
 duplicateImage :: HIplImage c d -> IO (HIplImage c d)
-duplicateImage img@(HIplImage _ _ _ _ _ _ ) =
+duplicateImage img@(HIplImage _ _ _ _ _ _ _ ) =
     do fptr <- mallocForeignPtrArray sz
        withForeignPtr (imageData img) $ 
            \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
-       return $ HIplImage 0 w h sz fptr stride
+       return $ HIplImage 0 w h sz fptr fptr stride
     where w = width img
           h = height img
           sz = imageSize img
@@ -129,7 +135,7 @@ withPixels :: forall a c d r.
               (HasChannels c, Integral a, HasDepth d) =>
               a -> a -> V.Vector d -> (HIplImage c d -> r) -> r
 withPixels w h pix f = if fromIntegral len == sz
-                       then f $ HIplImage 0 w' h' sz fp (w'*nc)
+                       then f $ HIplImage 0 w' h' sz fp fp (w'*nc)
                        else error "Length disagreement"
     where w' = fromIntegral w
           h' = fromIntegral h
@@ -146,7 +152,7 @@ fromPixels :: forall a c d.
               a -> a -> V.Vector d -> HIplImage c d
 fromPixels w h pix = unsafePerformIO $ 
                      do fp <- copyData
-                        return $ HIplImage 0 w' h' sz fp (w'*nc)
+                        return $ HIplImage 0 w' h' sz fp fp (w'*nc)
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 2c28531..32ffb28 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -7,7 +7,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtils
 
-foreign import ccall unsafe "opencv/cv.h cvCornerHarris"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
 
 harris :: Ptr IplImage -> Ptr IplImage -> Int -> Int -> Double -> IO ()
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 0beb160..315abc8 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -7,9 +7,9 @@ import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtils
 
-#include <opencv/cv.h>
+#include <opencv2/imgproc/types_c.h>
 
-foreign import ccall unsafe "opencv/cv.h cvSmooth"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSmooth"
   c_cvSmooth :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> CDouble -> 
                 CDouble -> IO ()
 
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 85e1d39..5c06d53 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -14,9 +14,9 @@ import AI.CV.OpenCV.Core.HIplUtils
 -- neighbors leads to a /floating/ range.
 data FloodRange = FloodFixed | FloodFloating
 
-#include <opencv/cv.h>
+#include <opencv2/imgproc/imgproc_c.h>
 
-foreign import ccall unsafe "opencv/cv.h cvFloodFill"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvFloodFill"
   c_cvFloodFill :: Ptr CvArr -> CInt -> CInt -> 
                    CDouble -> CDouble -> CDouble -> CDouble ->
                    CDouble -> CDouble -> CDouble -> CDouble ->
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index 666dc54..12b0729 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -1,30 +1,26 @@
 module AI.CV.OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
                          waitKey, cvInit) where
-import Control.Concurrent (forkIO, killThread, Chan, readChan)
-import Control.Monad (forever, (>=>))
 import AI.CV.OpenCV.Core.HIplImage
 import AI.CV.OpenCV.Core.HighGui
 import AI.CV.OpenCV.Core.CxCore (fromArr)
-import Foreign.C.String (withCString)
+import Control.Monad ((>=>))
+import Foreign.C.String (newCString)
 
-type KeyboardCallback = Int -> IO ()
+--type KeyboardCallback = Int -> IO ()
 
 -- |Create a new window with the given title. The return value is an
 -- action for destroying the window.
 namedWindow :: (HasChannels c, HasDepth d) => 
                String -> [WindowFlag] -> 
                Maybe MouseCallback -> 
-               Maybe KeyboardCallback ->
-               Chan (HIplImage c d) -> IO (IO ())
-namedWindow name flags _cb kcb c = 
-  withCString name $ \s ->
-    do cvNamedWindow s (windowFlagsToEnum flags)
-       t <- forkIO $ forever (readChan c >>= 
-                              flip withHIplImage (cvShowImage s . fromArr) >>
-                              waitKey 1 >>= kbWrap)
-       return (killThread t >> cvDestroyWindow s)
-    where kbWrap Nothing = return ()
-          kbWrap (Just x) = maybe (return ()) ($ x) kcb
+               --Maybe KeyboardCallback ->
+               IO (HIplImage c d -> IO (), IO ())
+namedWindow name flags _cb =
+  do cstr <- newCString name
+     let showImg img = withHIplImage img $ \imgPtr ->
+                         cvShowImage cstr (fromArr imgPtr)
+     cvNamedWindow cstr (windowFlagsToEnum flags)
+     return (showImg, cvDestroyWindow cstr)
 
 -- | @waitKey delay@ waits for a key indifinitely if @delay <= 0@, or
 -- for @delay@ milliseconds. The returned value is the code of the

From 7b584220bce63b11d174aa1213897618334ea85a Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 4 Feb 2011 22:19:33 -0500
Subject: [PATCH 063/137] Updated a couple more includes. Where is the C API
 for the video module in OpenCV 2.2?

---
 src/AI/CV/OpenCV/Motion.hsc   | 6 ++++--
 src/AI/CV/OpenCV/Threshold.hs | 2 +-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index f9e3b1d..5a6489c 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
--- |Motion analysis functions.
+-- |Motion analysis functions. Possibly BROKEN in OpenCV 2.2.
 module AI.CV.OpenCV.Motion (calcOpticalFlowBM) where
 import Data.Word (Word8)
 import Foreign.C.Types (CInt)
@@ -8,7 +8,9 @@ import System.IO.Unsafe
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplImage
 
-foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
+-- FIXME: This is missing from the C API of OpenCV 2.2
+--foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
+foreign import ccall unsafe "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
   c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
                            CInt -> CInt -> CInt -> CInt -> 
                            CInt -> Ptr CvArr -> Ptr CvArr -> IO ()
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 278ada2..18b2a8b 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -33,7 +33,7 @@ class (HasDepth d1, HasDepth d2) => SameOrByte d1 d2 where
 instance SameOrByte Float Word8 where
 instance ByteOrFloat d => SameOrByte d d where
 
-foreign import ccall unsafe "opencv/cv.h cvThreshold"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                    IO (CDouble)
 

From 623c64e9f3e2e5ba75701939e28ec046f718b2ed Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 9 Feb 2011 20:20:06 -0500
Subject: [PATCH 064/137] Put color conversion back in IO.

---
 src/AI/CV/OpenCV/ColorConversion.hs | 16 ++++++++--------
 src/AI/CV/OpenCV/PixelUtils.hs      |  6 +++---
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 093bbd4..a8dec2c 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 -- |Type-safe color conversion functions. 
 module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
@@ -5,29 +6,28 @@ module AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.Core.ColorConversion
-import Control.Monad.ST (runST, unsafeIOToST)
+--import System.IO.Unsafe (unsafePerformIO)
 
 convertGrayToRGB :: HasDepth d =>
-                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
+                    HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
 convertGrayToRGB = convertColor cv_GRAY2RGB
 
 convertGrayToBGR :: HasDepth d =>
-                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
+                    HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
 convertGrayToBGR = convertColor cv_GRAY2BGR
 
 convertBGRToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
+                    HIplImage TriChromatic d -> IO (HIplImage MonoChromatic d)
 convertBGRToGray = convertColor cv_BGR2GRAY
 
 convertRGBToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
+                    HIplImage TriChromatic d -> IO (HIplImage MonoChromatic d)
 convertRGBToGray = convertBGRToGray
 
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
-                ColorConversion -> HIplImage c1 d -> HIplImage c2 d
-convertColor cc img = runST $ unsafeIOToST $ 
-                      withHIplImage img $
+                ColorConversion -> HIplImage c1 d -> IO (HIplImage c2 d)
+convertColor cc img = withHIplImage img $
                         \src -> do dst <- mkHIplImage w h
                                    withHIplImage dst $
                                      \dst' -> cvCvtColor src dst' cc
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 3a0364a..6fc4e0f 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -65,7 +65,7 @@ isolateChannel ch img =
 {-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> V.Vector d
-toMono img = if imgChannels img == 1 then packPixels img
-             else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
+toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> IO (V.Vector d)
+toMono img = if imgChannels img == 1 then return $ packPixels img
+             else fmap packPixels (convertRGBToGray . isColor $ unsafeCoerce img)
 

From bb61ee34c7a072a6cb71440dd4f126b8ea2d62a4 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 9 Feb 2011 20:20:24 -0500
Subject: [PATCH 065/137] Added 16-bit PGM loading since OpenCV doesn't support
 it properly.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs | 39 +++++++++++++++++++++++++-----
 src/AI/CV/OpenCV/HighCV.hs         | 15 +++++++-----
 2 files changed, 42 insertions(+), 12 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index c0c432d..af38157 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -3,7 +3,7 @@
 -- |Functions for working with 'HIplImage's.
 module AI.CV.OpenCV.Core.HIplUtils 
     (isColor, isMono, imgChannels, withPixels, pixels,
-     fromPtr, fromFileColor, fromFileGray, toFile, 
+     fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, pipeline,
@@ -14,17 +14,19 @@ module AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
-import Control.Monad ((<=<))
+import Control.Arrow (second, (***))
+import Control.Monad ((<=<), when)
 import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
-import Data.Word (Word8)
+import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
 import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr
 import Foreign.Storable
 import System.Directory (doesFileExist)
+import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode, 
+                  IOMode(..))
 import System.IO.Unsafe
-import Unsafe.Coerce
 
 -- |This is a way to let the type checker know that you belieave an
 -- image to be tri-chromatic.
@@ -86,7 +88,7 @@ fromFileColor fileName =
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      freeROI ptr
      cvFree ptr
-     return $ unsafeCoerce img
+     return img
 
 -- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
 -- image file is color, it will be converted to grayscale.
@@ -96,7 +98,32 @@ fromFileGray fileName =
      ptr <- cvLoadImage fileName LoadGray
      img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8)
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
-     return $ unsafeCoerce img
+     return img
+
+-- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
+-- OpenCV (as of v2.2) does not correctly handle 16-bit PGM loading,
+-- so this 16bpp loader is restricted to PGM.
+fromPGM16 :: FilePath -> IO (HIplImage MonoChromatic Word16)
+fromPGM16 fileName = 
+  do checkFile fileName
+     h <- openFile fileName ReadMode
+     magic <- hGetLine h
+     when (magic /= "P5") (hClose h >> 
+                           error (fileName ++" is not a PGM"))
+     (width, height) <- fmap ((read***read). second tail . break (==' '))
+                             (hGetLine h)
+     maxCol <- hGetLine h
+     when (maxCol /= "65535") (hClose h >>
+                               error (fileName ++" is not 16-bit"))
+     let numBytes = width*height*2
+     fp <- mallocForeignPtrArray numBytes
+     hSetBinaryMode h True
+     withForeignPtr fp $ \ptr ->
+       do n <- hGetBuf h ptr numBytes
+          when (n /= numBytes) (hClose h >> 
+                                error (fileName ++" unexpected EOF"))
+     hClose h
+     return $ HIplImage 0 width height numBytes fp fp (2*width)
 
 -- |Save a 'HIplImage' to the specified file.
 toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 9466232..7f9c70d 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,15 +6,15 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             LineType(..), RGB, drawLines, HIplImage, width, 
                             height, pixels, withPixels, fromGrayPixels, 
                             fromColorPixels, fromFileGray, fromFileColor, 
-                            toFile, fromPtr, isColor, isMono, HasDepth, 
+                            fromPGM16, toFile, fromPtr, isColor, isMono,
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, cannyEdges, createFileCapture, 
                             createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, createVideoWriter, HasChannels,
                             module AI.CV.OpenCV.ColorConversion, GrayImage,
-                            ColorImage, createFileCaptureLoop, 
-                            module AI.CV.OpenCV.Threshold,
+                            ColorImage, GrayImage16, createFileCaptureLoop, 
+                            HasDepth, module AI.CV.OpenCV.Threshold,
                             module AI.CV.OpenCV.FloodFill)
     where
 import AI.CV.OpenCV.Core.CxCore
@@ -26,7 +26,7 @@ import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame,
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.ColorConversion
 --import AI.CV.OpenCV.Contours
-import Data.Word (Word8)
+import Data.Word (Word8, Word16)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
@@ -35,10 +35,13 @@ import Unsafe.Coerce
 import AI.CV.OpenCV.Threshold
 import AI.CV.OpenCV.FloodFill
 
--- |Grayscale 8-bit (per-pixel) image type synonym.
+-- |Grayscale 8-bit (per-pixel) image type.
 type GrayImage = HIplImage MonoChromatic Word8
 
--- |Color 8-bit (per-color) image type synonym.
+-- |Grayscale 16-bit (per-pixel) image type.
+type GrayImage16 = HIplImage MonoChromatic Word16
+
+-- |Color 8-bit (per-color) image type.
 type ColorImage = HIplImage TriChromatic Word8
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the

From 8fc85bd5a1a50646d20bb1774aa8b309ec7b71e5 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 10 Feb 2011 17:56:29 -0500
Subject: [PATCH 066/137] Export HIplImage accessors from HIplUtils so it is a
 useful "low-level" import.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index af38157..16e7bff 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -10,7 +10,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getROI) where
+     ByteOrFloat, getROI, HIplImage(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage

From f9a76fadb3636b31242bdde88dddc218d60f54d1 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 11 Feb 2011 10:50:55 -0500
Subject: [PATCH 067/137] Removed duplicate export from HIplUtils.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 16e7bff..e4efce8 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -10,7 +10,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getROI, HIplImage(..)) where
+     ByteOrFloat, getROI,imageData) where
 import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage

From 45f7de0e3a5be3627b42125e920225c13779b43f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 17 Feb 2011 21:23:00 -0500
Subject: [PATCH 068/137] Fixed byte ordering bug with 16-bit PGM loading.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index e4efce8..7cf6298 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -102,7 +102,9 @@ fromFileGray fileName =
 
 -- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
 -- OpenCV (as of v2.2) does not correctly handle 16-bit PGM loading,
--- so this 16bpp loader is restricted to PGM.
+-- so this 16bpp loader is restricted to PGM. This loading routine
+-- converts from Most Significant Byte first (MSB) byte ordering (as
+-- per the PGM spec) to LSB byte ordering for x86 compatibility.
 fromPGM16 :: FilePath -> IO (HIplImage MonoChromatic Word16)
 fromPGM16 fileName = 
   do checkFile fileName
@@ -118,10 +120,19 @@ fromPGM16 fileName =
      let numBytes = width*height*2
      fp <- mallocForeignPtrArray numBytes
      hSetBinaryMode h True
-     withForeignPtr fp $ \ptr ->
-       do n <- hGetBuf h ptr numBytes
+     withForeignPtr fp $ \ptr' ->
+       do let ptr = castPtr ptr' :: Ptr Word8
+          n <- hGetBuf h ptr numBytes
           when (n /= numBytes) (hClose h >> 
                                 error (fileName ++" unexpected EOF"))
+          let swapBytes !offset
+                | offset == numBytes = return ()
+                | otherwise = do temp1 <- peekByteOff ptr offset :: IO Word8
+                                 temp2 <- peekByteOff ptr (offset+1) :: IO Word8
+                                 pokeByteOff ptr offset temp2
+                                 pokeByteOff ptr (offset+1) temp1
+                                 swapBytes (offset+2)
+          swapBytes 0
      hClose h
      return $ HIplImage 0 width height numBytes fp fp (2*width)
 

From b28dac53e89519b82276e7aa9e77a85ee88091d0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 24 Feb 2011 13:26:31 -0500
Subject: [PATCH 069/137] Updated vector-space version dependency.

---
 HOpenCV.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 32fed74..3a6999c 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -58,7 +58,7 @@ library
    build-depends: base >=4 && <5, 
                   template-haskell,
                   allocated-processor >= 0.0.1, 
-                  vector-space,
+                  vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 1.1,
                   vector == 0.7.*
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing

From e4ffd1a12196d49dd35c9069b28d259e19c8b7fd Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 21 Apr 2011 15:51:38 -0400
Subject: [PATCH 070/137] Added names for de-Bayering to RGB and BGR.

---
 src/AI/CV/OpenCV/ColorConversion.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index a8dec2c..1cd71da 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -2,7 +2,8 @@
 -- |Type-safe color conversion functions. 
 module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
-     convertBGRToGray, convertRGBToGray) where
+     convertBGRToGray, convertRGBToGray,
+     convertBayerBgToBGR, convertBayerBgToRGB) where
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtils
 import AI.CV.OpenCV.Core.ColorConversion
@@ -24,6 +25,15 @@ convertRGBToGray :: HasDepth d =>
                     HIplImage TriChromatic d -> IO (HIplImage MonoChromatic d)
 convertRGBToGray = convertBGRToGray
 
+convertBayerBgToBGR :: HasDepth d =>
+                       HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+convertBayerBgToBGR = convertColor cv_BayerBG2BGR
+
+convertBayerBgToRGB :: HasDepth d =>
+                       HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+convertBayerBgToRGB = convertColor cv_BayerBG2RGB
+
+
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
                 ColorConversion -> HIplImage c1 d -> IO (HIplImage c2 d)

From 4467d6c928d57bb29d458b94b6ca0c63cb6495b9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Mon, 25 Apr 2011 18:03:35 -0400
Subject: [PATCH 071/137] Added Canny edge detector.

---
 src/AI/CV/OpenCV/Core/HIplUtils.hs   |  8 ++++++--
 src/AI/CV/OpenCV/FeatureDetection.hs | 21 ++++++++++++++++++++-
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtils.hs
index 7cf6298..cbc3721 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtils.hs
@@ -7,6 +7,7 @@ module AI.CV.OpenCV.Core.HIplUtils
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, pipeline,
+     unsafeWithHIplImage,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
@@ -16,7 +17,6 @@ import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
 import Control.Arrow (second, (***))
 import Control.Monad ((<=<), when)
-import Control.Monad.ST (runST, unsafeIOToST)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -237,12 +237,16 @@ withDuplicateImage img1 f = unsafePerformIO $
 withCompatibleImage :: (HasChannels c, HasDepth d) => 
                        HIplImage c d -> (Ptr IplImage -> IO b) -> 
                        (HIplImage c d, b)
-withCompatibleImage img1 f = runST $ unsafeIOToST $
+withCompatibleImage img1 f = unsafePerformIO $
                              do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
                                 return (img2, r)
 {-# NOINLINE withCompatibleImage #-}
 
+unsafeWithHIplImage :: (HasChannels c, HasDepth d) =>
+                       HIplImage c d -> (Ptr IplImage -> a) -> a
+unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
+
 -- |Extract a rectangular region of interest from an image. Returns a
 -- new image whose pixel data is copied from the ROI of the source
 -- image. Parameters are the upper-left corner of the ROI in image
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 32ffb28..27c349c 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 -- |Feature Detection.
-module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris') where
+module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import System.IO.Unsafe (unsafePerformIO)
@@ -45,3 +45,22 @@ cornerHarris' blockSize aperture k src =
                            withHIplImage dst $ \dst' ->
                              harris src' dst' blockSize aperture k
                          return dst
+
+foreign import ccall unsafe "opencv2/imgprog/imgproc_c.h cvCanny"
+  c_cvCanny :: Ptr IplImage -> Ptr IplImage -> CDouble -> CDouble -> CInt -> IO ()
+
+-- |Canny edge detector. @canny threshold1 threshold2 aperture src@
+-- finds edges in the source image with the larger of the two
+-- thresholds used to find initial segments of strong edges while the
+-- smaller threshold is used for edge linking. The third parameter is
+-- the aperture size used for initial Sobel operator edge detection.
+canny :: HasDepth d =>
+         Double -> Double -> Int -> HIplImage MonoChromatic d -> 
+         HIplImage MonoChromatic d
+canny t1 t2 aperture src = 
+  unsafeWithHIplImage src $ \src' ->
+    fst . withCompatibleImage src $ \dst ->
+          c_cvCanny src' dst (rf t1) (rf t2) (fi aperture)
+  where rf = realToFrac
+        fi = fromIntegral
+    
\ No newline at end of file

From c7600dcb8e5b378bf27459758f32d1f91532af8f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 May 2011 18:58:10 -0400
Subject: [PATCH 072/137] Renamed HIplUtils to HIplUtil. Added overloaded
 fromFile.

---
 HOpenCV.cabal                                 |  6 ++---
 src/AI/CV/OpenCV/ArrayOps.hs                  |  2 +-
 src/AI/CV/OpenCV/ColorConversion.hs           |  3 +--
 src/AI/CV/OpenCV/Core/CV.hsc                  |  1 -
 .../OpenCV/Core/{HIplUtils.hs => HIplUtil.hs} | 27 ++++++++++++++-----
 src/AI/CV/OpenCV/FeatureDetection.hs          |  2 +-
 src/AI/CV/OpenCV/Filtering.hsc                |  2 +-
 src/AI/CV/OpenCV/FloodFill.hsc                |  2 +-
 src/AI/CV/OpenCV/HighCV.hs                    |  2 +-
 src/AI/CV/OpenCV/PixelUtils.hs                |  2 +-
 src/AI/CV/OpenCV/Threshold.hs                 |  2 +-
 11 files changed, 32 insertions(+), 19 deletions(-)
 rename src/AI/CV/OpenCV/Core/{HIplUtils.hs => HIplUtil.hs} (93%)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 3a6999c..d1e378f 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -32,7 +32,7 @@ library
       AI.CV.OpenCV.Core.CxCore
       AI.CV.OpenCV.Core.HighGui
       AI.CV.OpenCV.Core.HIplImage
-      AI.CV.OpenCV.Core.HIplUtils
+      AI.CV.OpenCV.Core.HIplUtil
       AI.CV.OpenCV.Core.ColorConversion
       AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.GUI
@@ -47,7 +47,7 @@ library
       AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-   other-modules: AI.CV.OpenCV.Core.PipelineTH
+   other-modules: 
    hs-Source-Dirs: src
    if os(windows)
      include-dirs: C:\\OpenCV2.1\\include
@@ -59,6 +59,6 @@ library
                   template-haskell,
                   allocated-processor >= 0.0.1, 
                   vector-space >= 0.7.2,
-                  directory >= 1.0.1.0 && < 1.1,
+                  directory >= 1.0.1.0 && < 2,
                   vector == 0.7.*
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 13c99bd..4a9ac91 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -8,7 +8,7 @@ import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 1cd71da..e9ed239 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -5,9 +5,8 @@ module AI.CV.OpenCV.ColorConversion
      convertBGRToGray, convertRGBToGray,
      convertBayerBgToBGR, convertBayerBgToRGB) where
 import AI.CV.OpenCV.Core.CV
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
---import System.IO.Unsafe (unsafePerformIO)
 
 convertGrayToRGB :: HasDepth d =>
                     HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
index 6aa050f..4e26477 100644
--- a/src/AI/CV/OpenCV/Core/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -16,7 +16,6 @@ import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Marshal.Array (peekArray)
 import Foreign.Storable (Storable, sizeOf)
 import Foreign.Ptr
---import Data.Bits
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.ColorConversion
 
diff --git a/src/AI/CV/OpenCV/Core/HIplUtils.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
similarity index 93%
rename from src/AI/CV/OpenCV/Core/HIplUtils.hs
rename to src/AI/CV/OpenCV/Core/HIplUtil.hs
index cbc3721..d643af9 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtils.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -1,17 +1,16 @@
 {-# LANGUAGE ScopedTypeVariables, BangPatterns, MultiParamTypeClasses, 
              FlexibleInstances #-}
 -- |Functions for working with 'HIplImage's.
-module AI.CV.OpenCV.Core.HIplUtils 
+module AI.CV.OpenCV.Core.HIplUtil
     (isColor, isMono, imgChannels, withPixels, pixels,
      fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, pipeline,
-     unsafeWithHIplImage,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getROI,imageData) where
+     ByteOrFloat, getROI, imageData, fromFile, unsafeWithHIplImage) where
 import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
@@ -68,6 +67,7 @@ pixels img = unsafePerformIO $
                         copyBytes dst src len
                 return $ V.unsafeFromForeignPtr ptr 0 len
     where len = imageSize img
+{-# NOINLINE pixels #-}
 
 -- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
 fromPtr :: (HasChannels c, HasDepth d) => Ptr IplImage -> IO (HIplImage c d)
@@ -100,6 +100,23 @@ fromFileGray fileName =
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      return img
 
+class LoadableFormat c d where
+  loadFormat :: (c,d) -> FilePath -> IO (HIplImage c d)
+
+instance LoadableFormat MonoChromatic Word8 where
+  loadFormat _ = fromFileGray
+
+instance LoadableFormat TriChromatic Word8 where
+  loadFormat _ = fromFileColor
+
+instance LoadableFormat MonoChromatic Word16 where
+  loadFormat _ = fromPGM16
+
+-- |An overloaded image file loader. The number of color channels and
+-- color depth parts of the returned image's type must be inferrable.
+fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (HIplImage c d)
+fromFile = loadFormat (undefined :: (c,d))
+
 -- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
 -- OpenCV (as of v2.2) does not correctly handle 16-bit PGM loading,
 -- so this 16bpp loader is restricted to PGM. This loading routine
@@ -140,7 +157,6 @@ fromPGM16 fileName =
 toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
-
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
@@ -253,9 +269,8 @@ unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
 -- coordinates, the (width,height) of the ROI in pixels, and the
 -- source 'HIplImage'.
 getROI :: (HasChannels c, HasDepth d) =>
-          (Int,Int) -> (Int,Int) -> HIplImage c d -> HIplImage c d
+          (Int,Int) -> (Int,Int) -> HIplImage c d -> IO (HIplImage c d)
 getROI (rx,ry) (rw,rh) src = 
-    unsafePerformIO $
     do img <- mkHIplImage rw rh
        withForeignPtr (imageData img) $ \dst ->
          withForeignPtr (imageData src) $ \src ->
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 27c349c..4f0786b 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -5,7 +5,7 @@ import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 
 foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 315abc8..89398e5 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -5,7 +5,7 @@ import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 
 #include <opencv2/imgproc/types_c.h>
 
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 5c06d53..f2d4f02 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -5,7 +5,7 @@ import Data.Bits ((.|.))
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
 import AI.CV.OpenCV.Core.CxCore 
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 
 -- |Flag used to indicate whether pixels under consideration for
 -- addition to a connected component should be compared to the seed
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 7f9c70d..e5eaf26 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -23,7 +23,7 @@ import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame,
                                   setCapturePos, CapturePos(PosFrames), 
                                   CvCapture, createCameraCaptureF, 
                                   createVideoWriterF, cvWriteFrame, FourCC)
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.ColorConversion
 --import AI.CV.OpenCV.Contours
 import Data.Word (Word8, Word16)
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 6fc4e0f..34ea46d 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -5,7 +5,7 @@
 -- bytes.
 module AI.CV.OpenCV.PixelUtils where
 import AI.CV.OpenCV.Core.HIplImage
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.ColorConversion (convertRGBToGray)
 import Control.Monad.ST (runST)
 import qualified Data.Vector.Storable as V
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 18b2a8b..cf98621 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -15,7 +15,7 @@ import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore 
-import AI.CV.OpenCV.Core.HIplUtils
+import AI.CV.OpenCV.Core.HIplUtil
 
 data ThresholdType = ThreshBinary
                    | ThreshBinaryInv

From f6ab941a470bfa4c222c302869c38c53af6f9c10 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 24 May 2011 19:21:10 -0400
Subject: [PATCH 073/137] Start pushing the CVOp fusion abstraction through.

---
 HOpenCV.cabal                        |   2 +-
 src/AI/CV/OpenCV/ArrayOps.hs         | 193 ++++++---------------------
 src/AI/CV/OpenCV/ColorConversion.hs  |  18 +--
 src/AI/CV/OpenCV/Core/CVOp.hs        | 139 +++++++++++++++++++
 src/AI/CV/OpenCV/Core/CxCore.hsc     |   7 +-
 src/AI/CV/OpenCV/Core/HIplImage.hsc  |  14 +-
 src/AI/CV/OpenCV/Core/HIplUtil.hs    |  43 ++++--
 src/AI/CV/OpenCV/FeatureDetection.hs |  18 +--
 src/AI/CV/OpenCV/Filtering.hsc       |  41 +-----
 src/AI/CV/OpenCV/FloodFill.hsc       |  18 +--
 src/AI/CV/OpenCV/HighCV.hs           | 145 +++++++-------------
 src/AI/CV/OpenCV/PixelUtils.hs       |   6 +-
 src/Examples/CamCanny/CamCanny.hs    |  20 +++
 13 files changed, 322 insertions(+), 342 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/Core/CVOp.hs
 create mode 100644 src/Examples/CamCanny/CamCanny.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index d1e378f..e919636 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -47,7 +47,7 @@ library
       AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-   other-modules: 
+   other-modules: AI.CV.OpenCV.Core.CVOp
    hs-Source-Dirs: src
    if os(windows)
      include-dirs: C:\\OpenCV2.1\\include
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 4a9ac91..215c7c5 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -9,6 +9,7 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -18,28 +19,10 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvSubRS"
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
           IsCvScalar s, s ~ CvScalar c d) =>
          s -> HIplImage c d -> HIplImage c d
-subRS value src = unsafePerformIO $ 
-                  withHIplImage src $ \srcPtr ->
-                    return . fst . withCompatibleImage src $ \dstPtr -> 
-                      c_cvSubRS (castPtr srcPtr) r g b a (castPtr dstPtr) 
-                                nullPtr
+subRS value = cv2 $ \src dst -> 
+              c_cvSubRS (castPtr src) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar value
-
--- Unsafe in-place pointwise subtraction of each pixel from a given
--- scalar value.
-unsafeSubRS :: (HasChannels c, HasDepth d, HasScalar c d,
-                IsCvScalar s, s ~ CvScalar c d) =>
-               s -> HIplImage c d -> IO (HIplImage c d)
-unsafeSubRS value src = withHIplImage src $ \srcPtr ->
-                            do c_cvSubRS (castPtr srcPtr) r g b a
-                                         (castPtr srcPtr) nullPtr
-                               return src
-    where (r,g,b,a) = toCvScalar value
-
-{-# RULES 
-"subRS/in-place" [~1] forall v. subRS v = pipeline (unsafeSubRS v)
-"subRS/unpipe" [1] forall v. pipeline (unsafeSubRS v) = subRS v
-  #-}
+{-# INLINE subRS #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
@@ -47,25 +30,10 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvAbsDiff"
 -- |Calculate the absolute difference between two images.
 absDiff :: (HasChannels c, HasDepth d) => 
            HIplImage c d -> HIplImage c d -> HIplImage c d
-absDiff src1 src2 = unsafePerformIO $
-                    withHIplImage src1 $ \src1' ->
-                      withHIplImage src2 $ \src2' ->
-                        return . fst . withCompatibleImage src1 $ \dst ->
-                          c_cvAbsDiff (castPtr src1') (castPtr src2') 
-                                      (castPtr dst)
-
-unsafeAbsDiff :: (HasChannels c, HasDepth d) => 
-                 HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
-unsafeAbsDiff src1 src2 = withHIplImage src1 $ \src1' ->
-                            withHIplImage src2 $ \src2' ->
-                                do c_cvAbsDiff (castPtr src1') (castPtr src2') 
-                                               (castPtr src2')
-                                   return src2
-
-{-# RULES 
-"absDiff/in-place" [~1] forall m. absDiff m = pipeline (unsafeAbsDiff m)
-"absDiff/unpipe" [1] forall m. pipeline (unsafeAbsDiff m) = absDiff m
-  #-}
+absDiff src1 = cv2 $ \src2 dst -> 
+               withHIplImage src1 $ \src1' ->
+                 c_cvAbsDiff (castPtr src1') (castPtr src2) (castPtr dst)
+{-# INLINE absDiff #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvConvertScale"
   c_cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
@@ -89,6 +57,7 @@ convertScale scale shift src = unsafePerformIO $
                                                        (realToFrac scale) 
                                                        (realToFrac shift)
                                   return dst
+{-# NOINLIN convertScale #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
@@ -106,43 +75,18 @@ cvAndHelper src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
 cvAndMask :: (HasChannels c, HasDepth d) => 
              HIplImage MonoChromatic Word8 -> HIplImage c d ->  
              HIplImage c d -> HIplImage c d
-cvAndMask mask src1 src2 = fst . withDuplicateImage src2 $ \dst ->
-                             withHIplImage src1 $ \src1' ->
-                               withHIplImage src2 $ \src2' ->
-                                 withHIplImage mask $ \mask' ->
-                                   cvAndHelper src1' src2' dst mask'
+cvAndMask mask src1 = cv2 $ \src2 dst -> 
+                      withHIplImage src1 $ \src1' -> 
+                          withHIplImage mask $ \mask' ->
+                              cvAndHelper src1' src2 dst mask'
+{-# INLINE cvAndMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
           HIplImage c d -> HIplImage c d ->  HIplImage c d
-cvAnd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
-                    withHIplImage src1 $ \src1' ->
-                      withHIplImage src2 $ \src2' ->
-                        cvAndHelper src1' src2' dst nullPtr
-
-unsafeAnd :: (HasChannels c, HasDepth d) => 
-             HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
-unsafeAnd src1 src2 = withHIplImage src1 $ \src1' ->
-                        withHIplImage src2 $ \src2' ->
-                          cvAndHelper src1' src2' src2' nullPtr >> return src2
-
-unsafeAndMask :: (HasChannels c, HasDepth d) => 
-                 HIplImage MonoChromatic Word8 -> HIplImage c d ->  
-                 HIplImage c d -> IO (HIplImage c d)
-unsafeAndMask mask src1 src2 = withHIplImage src1 $ \src1' ->
-                                 withHIplImage src2 $ \src2' ->
-                                   withHIplImage mask $ \mask' ->
-                                     cvAndHelper src1' src2' src2' mask' >> 
-                                     return src2
-
-{-# RULES 
-"cvAnd/in-place" [~1] forall s. cvAnd s = pipeline (unsafeAnd s)
-"cvAnd/unpipe" [1] forall s. pipeline (unsafeAnd s) = cvAnd s
-"cvAndMask/in-place" [~1] forall m s. 
-  cvAndMask m s = pipeline (unsafeAndMask m s)
-"cvAndMask/unpipe" [1] forall m s.
-  pipeline (unsafeAndMask m s) = cvAndMask m s
-  #-}
+cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
+             cvAndHelper src1' src2 dst nullPtr
+{-# INLINE cvAnd #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvAndS"
    c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -152,23 +96,10 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvAndS"
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
            s ~ CvScalar c d) => 
           s -> HIplImage c d -> HIplImage c d
-cvAndS s img = fst . withCompatibleImage img $ \dst ->
-                 withHIplImage img $ \src ->
-                   c_cvAndS (castPtr src) r g b a (castPtr dst) nullPtr
-    where (r,g,b,a) = toCvScalar s
-
-unsafeAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
-               s ~ CvScalar c d) => 
-              s -> HIplImage c d -> IO (HIplImage c d)
-unsafeAndS s img = do withHIplImage img $ \src ->
-                        c_cvAndS (castPtr src) r g b a (castPtr src) nullPtr
-                      return img
+cvAndS s = cv2 $ \img dst -> 
+           c_cvAndS (castPtr img) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar s
-
-{-# RULES 
-"cvAndS/in-place" [~1] forall s. cvAndS s = pipeline (unsafeAndS s)
-"cvAndS/unpipe" [1] forall s. pipeline (unsafeAndS s) = cvAndS s
-  #-}
+{-# INLINE cvAndS #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -177,12 +108,12 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvScaleAdd"
 cvScaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
                s ~ CvScalar c d, IsCvScalar s) => 
               HIplImage c d -> s -> HIplImage c d -> HIplImage c d
-cvScaleAdd src1 s src2 = fst . withCompatibleImage src1 $ \dst ->
-                           withHIplImage src1 $ \src1' ->
-                             withHIplImage src2 $ \src2' ->
-                               c_cvScaleAdd (castPtr src1') r g b a 
-                                            (castPtr src2') (castPtr dst)
+cvScaleAdd src1 s = cv2 $ \src2 dst ->
+                    withHIplImage src1 $ \src1' ->
+                        c_cvScaleAdd (castPtr src1') r g b a 
+                                     (castPtr src2) (castPtr dst)
     where (r,g,b,a) = toCvScalar s
+{-# INLINE cvScaleAdd #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
@@ -194,40 +125,19 @@ cvMulHelper src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2)
 -- |Per-element product of two arrays.
 cvMul :: (HasChannels c, HasDepth d) => 
          HIplImage c d -> HIplImage c d -> HIplImage c d
-cvMul src1 src2 = fst . withCompatibleImage src1 $ \dst ->
-                    withHIplImage src1 $ \src1' ->
-                      withHIplImage src2 $ \src2' ->
-                        cvMulHelper src1' src2' dst 1
+cvMul src1 = cv2 $ \src2 dst -> 
+             withHIplImage src1 $ \src1' ->
+                 cvMulHelper src1' src2 dst 1
+{-# INLINE cvMul #-}
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
 cvMul' :: (HasChannels c, HasDepth d) => 
           Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
-cvMul' scale src1 src2 = fst . withCompatibleImage src1 $ \dst ->
-                           withHIplImage src1 $ \src1' ->
-                               withHIplImage src2 $ \src2' ->
-                                   cvMulHelper src1' src2' dst scale
-
-unsafeMul :: (HasChannels c, HasDepth d) => 
-             HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
-unsafeMul src1 src2 = do withHIplImage src1 $ \src1' ->
-                             withHIplImage src2 $ \src2' ->
-                                 cvMulHelper src1' src2' src2' 1
-                         return src2
-
-unsafeMul' :: (HasChannels c, HasDepth d) => 
-              Double -> HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
-unsafeMul' scale src1 src2 = do withHIplImage src1 $ \src1' ->
-                                  withHIplImage src2 $ \src2' ->
-                                    cvMulHelper src1' src2' src2' scale
-                                return src2
-
-{-# RULES 
-"cvMul/in-place" [~1] forall s1. cvMul s1 = pipeline (unsafeMul s1)
-"cvMul/unpipe" [1] forall s1. pipeline (unsafeMul s1) = cvMul s1
-"cvMul'/in-place" [~1] forall s s1. cvMul' s s1 = pipeline (unsafeMul' s s1)
-"cvMul'/unpipe" [1] forall s s1. pipeline (unsafeMul' s s1) = cvMul' s s1
-  #-}
+cvMul' scale src1 = cv2 $ \src2 dst ->
+                    withHIplImage src1 $ \src1' ->
+                        cvMulHelper src1' src2 dst scale
+{-# INLINE cvMul' #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
@@ -235,19 +145,10 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvAdd"
 -- |Per-element sum of two arrays.
 cvAdd :: (HasChannels c, HasDepth d) => 
          HIplImage c d -> HIplImage c d -> HIplImage c d
-cvAdd src1 src2 = fst . withCompatibleImage src1 $ \dst ->
-                    withHIplImage src1 $ \src1' ->
-                      withHIplImage src2 $ \src2' ->
-                         c_cvAdd (castPtr src1') (castPtr src2') 
-                                 (castPtr dst) nullPtr
-
-unsafeAdd  :: (HasChannels c, HasDepth d) => 
-              HIplImage c d -> HIplImage c d -> IO (HIplImage c d)
-unsafeAdd src1 src2 = do withHIplImage src1 $ \src1' ->
-                           withHIplImage src2 $ \src2' ->
-                             c_cvAdd (castPtr src1') (castPtr src2') 
-                                     (castPtr src2') nullPtr
-                         return src2
+cvAdd src1 = cv2 $ \src2 dst ->
+             withHIplImage src1 $ \src1' ->
+                 c_cvAdd (castPtr src1') (castPtr src2) (castPtr dst) nullPtr
+{-# INLINE cvAdd #-}
 
 foreign import ccall unsafe "opencv2/core/core_c.h cvAddS"
   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
@@ -255,21 +156,7 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvAddS"
 
 cvAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
           s -> HIplImage c d -> HIplImage c d
-cvAddS scalar src = fst . withCompatibleImage src $ \dst ->
-                      withHIplImage src $ \src' ->
-                        c_cvAddS (castPtr src') r g b a (castPtr dst) nullPtr
+cvAddS scalar = cv2 $ \src dst -> 
+                c_cvAddS (castPtr src) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar scalar
-
-unsafeAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-              s -> HIplImage c d -> IO (HIplImage c d)
-unsafeAddS scalar src = do withHIplImage src $ \src' ->
-                             c_cvAddS (castPtr src') r g b a (castPtr src') nullPtr
-                           return src
-    where (r,g,b,a) = toCvScalar scalar
-
-{-# RULES
-"cvAdd/in-place" [~1] forall s. cvAdd s = pipeline (unsafeAdd s)
-"cvAdd/unpipe" [1] forall s. pipeline (unsafeAdd s) = cvAdd s
-"cvAddS/in-place" [~1] forall s. cvAddS s = pipeline (unsafeAddS s)
-"cvAddS/unpipe" [1] forall s. pipeline (unsafeAddS s) = cvAddS s
-  #-}
+{-# INLINE cvAddS #-}
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index e9ed239..d6252d6 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -7,39 +7,41 @@ module AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
+import System.IO.Unsafe
 
 convertGrayToRGB :: HasDepth d =>
-                    HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToRGB = convertColor cv_GRAY2RGB
 
 convertGrayToBGR :: HasDepth d =>
-                    HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToBGR = convertColor cv_GRAY2BGR
 
 convertBGRToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> IO (HIplImage MonoChromatic d)
+                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertBGRToGray = convertColor cv_BGR2GRAY
 
 convertRGBToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> IO (HIplImage MonoChromatic d)
+                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertRGBToGray = convertBGRToGray
 
 convertBayerBgToBGR :: HasDepth d =>
-                       HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+                       HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertBayerBgToBGR = convertColor cv_BayerBG2BGR
 
 convertBayerBgToRGB :: HasDepth d =>
-                       HIplImage MonoChromatic d -> IO (HIplImage TriChromatic d)
+                       HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
 
 
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
-                ColorConversion -> HIplImage c1 d -> IO (HIplImage c2 d)
-convertColor cc img = withHIplImage img $
+                ColorConversion -> HIplImage c1 d -> HIplImage c2 d
+convertColor cc img = unsafePerformIO . withHIplImage img $
                         \src -> do dst <- mkHIplImage w h
                                    withHIplImage dst $
                                      \dst' -> cvCvtColor src dst' cc
                                    return dst
     where w = width img
           h = height img
+{-# NOINLINE convertColor #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
new file mode 100644
index 0000000..d62d5da
--- /dev/null
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -0,0 +1,139 @@
+module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
+import AI.CV.OpenCV.Core.CxCore (IplImage)
+import AI.CV.OpenCV.Core.HIplUtil
+import Control.Monad ((>=>), void)
+import Data.Monoid
+import Foreign.Ptr
+import Foreign.ForeignPtr
+import System.IO.Unsafe
+
+import Control.Category (Category)
+import qualified Control.Category as Cat
+
+
+-- |A CV operation is an IO function on a 'HIplImage'.
+newtype CVOp c d = CVOp { op :: Ptr IplImage -> IO () }
+
+cv :: (HasChannels c, HasDepth d) => 
+      (Ptr IplImage -> IO a) -> HIplImage c d -> HIplImage c d
+cv = runCV . CVOp . (void .)
+{-# INLINE cv #-}
+
+instance Monoid (CVOp c d) where
+  mempty = CVOp . const $ return ()
+  CVOp f `mappend` CVOp g = CVOp (\x -> g x >> f x)
+  {-# INLINE mappend #-}
+
+withClone :: (HasChannels c, HasDepth d) =>
+             (Ptr IplImage -> IO a) -> HIplImage c d -> IO (HIplImage c d)
+withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f x >> fromPtr x)
+
+-- |Run a 'CVOp'.
+-- runCV :: (HasChannels c, HasDepth d) => CVOp r -> HIplImage c d -> HIplImage c d
+-- runCV = ((unsafePerformIO . fmap fst) .) . flip withDuplicateImageIO . runKleisli
+runCV :: (HasChannels c, HasDepth d) => 
+         CVOp c d -> HIplImage c d -> HIplImage c d
+runCV = (unsafePerformIO .) . withClone . op
+{-# NOINLINE runCV #-}
+
+-- makeUnary f = \img -> do dst <- compatibleImagePtrPtr img
+--                          f img dst
+--                          return dst
+
+newtype CVOpBi c d = CVOpBi { opbi :: Ptr IplImage -> Ptr IplImage -> IO () }
+
+instance Monoid (CVOpBi c d) where
+    mempty = CVOpBi $ \ _ _ -> return ()
+    CVOpBi f `mappend` CVOpBi g = CVOpBi $ \x y -> g x y >> f y y
+    {-# INLINE mappend #-}
+
+{-
+withComp :: (HasChannels c, HasDepth d) =>
+            (Ptr IplImage -> Ptr IplImage -> IO a) -> 
+            HIplImage c d -> IO (HIplImage c d)
+withComp f img = compatibleImagePtr img >>= 
+                 flip withForeignPtr (\x -> withHIplImage img (flip f x) >> 
+                                            fromPtr x)
+-}
+withComp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
+            (Ptr IplImage -> Ptr IplImage -> IO a) -> 
+            HIplImage c1 d1 -> IO (HIplImage c2 d2)
+withComp f img = mkHIplImage (width img) (height img) >>= \img2 -> 
+                 withHIplImage img2 (\x -> withHIplImage img (flip f x) >> 
+                                           return img2)
+
+
+runCVComp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+             CVOpBi c d -> HIplImage c1 d1 -> HIplImage c2 d2
+runCVComp = (unsafePerformIO .) . withComp . opbi
+{-# NOINLINE runCVComp #-}
+
+-- Apply a binary function to the same argument twice.
+dupArg :: (Ptr IplImage -> Ptr IplImage -> IO ()) -> Ptr IplImage -> IO ()
+dupArg f = \x -> f x x
+
+-- |Operations that want an argument /and/ a compatible destination
+-- buffer, but don't need a clone of an input.
+cv2 :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+       (Ptr IplImage -> Ptr IplImage -> IO a) -> 
+       HIplImage c1 d1 -> HIplImage c2 d2
+--cv2 = runCVComp . CVOpBi . ((void .) .)
+cv2 = runBinOp . BinOp . ((void .) .)
+{-# INLINE cv2 #-}
+{-
+bi2unary :: CVOpBi c d -> CVOp c d
+bi2unary = CVOp . dupArg . opbi
+
+unary2bi :: CVOp c d -> CVOpBi c d
+unary2bi = CVOpBi . const . op
+-}
+
+bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
+bi2unary = CVOp . dupArg . binop
+
+unary2bi :: CVOp c d -> BinOp (c,d) (c,d)
+unary2bi = BinOp . const . op
+
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}
+
+newtype BinOp a b = 
+    BinOp { binop :: Ptr IplImage -> Ptr IplImage -> IO () }
+
+instance Category BinOp where
+    id = BinOp . const . const $ return ()
+    BinOp f . BinOp g = BinOp $ \x y -> g x y >> f y y
+
+withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+           (Ptr IplImage -> Ptr IplImage -> IO a) ->
+           HIplImage c1 d1 -> IO (HIplImage c2 d2)
+withDst f img = mkHIplImage (width img) (height img) >>= \img2 ->
+                withHIplImage img2 (\x -> withHIplImage img (flip f x) >>
+                                          return img2)
+
+runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 -> HIplImage c2 d2
+runBinOp = (unsafePerformIO .) . withDst . binop
+
+{-# RULES "runCV/fuse"
+    forall f g x. runCV f (runCV g x) = runCV (f <> g) x #-}
+
+{-# RULES "runBinOp/fuse"
+    forall f g x. runBinOp f (runBinOp g x) = runBinOp ((Cat..) f g) x #-}
+
+{-# RULES "runCV/runBinOp/fuse"
+    forall f g x. runCV f (runBinOp g x) = runBinOp ((Cat..) (unary2bi f) g) x #-}
+
+{-# RULES "runBinOp/runCV/fuse"
+    forall f g x. runBinOp f (runCV g x) = runCV (bi2unary f <> g) x #-}
+
+
+{-# RULES "cvComp/cvComp/fuse"
+    forall f g x. runCVComp f (runCVComp g x) = runCVComp (f <> g) x #-}
+
+{- RULES "runCV/cvComp/apply"
+    forall f g x. runCV f (runCVComp g x) = runCVComp (unary2bi f <> g) x -}
+
+{- RULES "cvComp/runCV/apply"
+    forall f g x. runCVComp f (runCV g x) = runCV (bi2unary f <> g) x -}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 389ee93..ae27cb0 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -8,7 +8,7 @@ import Foreign.ForeignPtrWrap
 import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import Foreign.Storable
-import System.IO.Unsafe (unsafePerformIO)
+--import System.IO.Unsafe (unsafePerformIO)
 
 import Data.VectorSpace as VectorSpace
 
@@ -217,9 +217,8 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvCopy"
 cvCopy :: IplArrayType a => Ptr a -> Ptr a -> IO ()
 cvCopy src dst = c_cvCopy (fromArr src) (fromArr dst) nullPtr
 
-cvGetSize :: IplArrayType a => Ptr a -> CvSize
-cvGetSize p = unsafePerformIO $
-              alloca $ \cvSizePtr -> do
+cvGetSize :: IplArrayType a => Ptr a -> IO CvSize
+cvGetSize p = alloca $ \cvSizePtr -> do
                 c_get_size (castPtr p) cvSizePtr
                 size <- peek cvSizePtr
                 return size
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 5e1cbd1..7d98061 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -123,13 +123,13 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
 -- pixel depth (e.g. 'Word8', 'Float').
 data HIplImage c d = (HasChannels c, HasDepth d) => 
-                     HIplImage { origin    :: Int
-                               , width     :: Int
-                               , height    :: Int
-                               , imageSize :: Int
-                               , imageData :: ForeignPtr d
-                               , imageDataOrigin :: ForeignPtr d
-                               , widthStep :: Int }
+                     HIplImage { origin    :: !Int
+                               , width     :: !Int
+                               , height    :: !Int
+                               , imageSize :: !Int
+                               , imageData :: !(ForeignPtr d)
+                               , imageDataOrigin :: !(ForeignPtr d)
+                               , widthStep :: !Int }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index d643af9..a048edc 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -10,12 +10,16 @@ module AI.CV.OpenCV.Core.HIplUtil
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getROI, imageData, fromFile, unsafeWithHIplImage) where
-import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr)
+     ByteOrFloat, getROI, imageData, fromFile, unsafeWithHIplImage,
+     duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
+import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF, 
+                                 CvSize(..), cloneImageF, cvCreateImage, 
+                                 getNumChannels, getDepth, cvGetSize)
 import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
+import Control.Applicative
 import Control.Arrow (second, (***))
-import Control.Monad ((<=<), when)
+import Control.Monad ((<=<), when, join)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -169,6 +173,21 @@ compatibleImage img@(HIplImage _ _ _ _ _ _ _) =
           sz = imageSize img
           stride = widthStep img
 
+-- |Allocate a new 'IplImage' with the same dimensions, number of
+-- color channels, and color depth as an existing 'HIplImage'. The
+-- pixel data of the original 'HIplImage' is not copied.
+compatibleImagePtr :: forall c d. (HasChannels c, HasDepth d) =>
+                      HIplImage c d -> IO (ForeignPtr IplImage)
+compatibleImagePtr img = createImageF (CvSize w' h') c d
+    where w' = fromIntegral . width $ img
+          h' = fromIntegral . height $ img
+          c = fromIntegral . numChannels $ (undefined::c)
+          d = depth (undefined::d)
+
+compatibleImagePtrPtr :: Ptr IplImage -> IO (Ptr IplImage)
+compatibleImagePtrPtr = 
+    join . (liftA3 cvCreateImage <$> cvGetSize <*> getNumChannels <*> getDepth)
+
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
 duplicateImage :: HIplImage c d -> IO (HIplImage c d)
@@ -182,6 +201,12 @@ duplicateImage img@(HIplImage _ _ _ _ _ _ _ ) =
           sz = imageSize img
           stride = widthStep img
 
+-- |Clone an 'HIplImage', returning the 'Ptr' 'IplImage' underlying
+-- the clone.
+duplicateImagePtr :: (HasChannels c, HasDepth d) =>
+                     HIplImage c d -> IO (ForeignPtr IplImage)
+duplicateImagePtr = flip withHIplImage cloneImageF
+
 -- |Pass the given function a 'HIplImage' constructed from a width, a
 -- height, and a 'V.Vector' of pixel values. The new 'HIplImage' \'s
 -- pixel data is shared with the supplied 'V.Vector'.
@@ -240,24 +265,20 @@ fromColorPixels w h = isColor . fromPixels w h
 -- performing the given action along with the result of that action.
 withDuplicateImage :: (HasChannels c, HasDepth d) => 
                       HIplImage c d -> (Ptr IplImage -> IO b) -> 
-                      (HIplImage c d, b)
-withDuplicateImage img1 f = unsafePerformIO $
-                            do img2 <- duplicateImage img1
+                      IO (HIplImage c d, b)
+withDuplicateImage img1 f = do img2 <- duplicateImage img1
                                r <- withHIplImage img2 f
                                return (img2, r)
-{-# NOINLINE withDuplicateImage #-}
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
 withCompatibleImage :: (HasChannels c, HasDepth d) => 
                        HIplImage c d -> (Ptr IplImage -> IO b) -> 
-                       (HIplImage c d, b)
-withCompatibleImage img1 f = unsafePerformIO $
-                             do img2 <- compatibleImage img1
+                       IO (HIplImage c d, b)
+withCompatibleImage img1 f = do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
                                 return (img2, r)
-{-# NOINLINE withCompatibleImage #-}
 
 unsafeWithHIplImage :: (HasChannels c, HasDepth d) =>
                        HIplImage c d -> (Ptr IplImage -> a) -> a
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 4f0786b..2fbd388 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -3,9 +3,9 @@
 module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
-import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 
 foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
@@ -27,6 +27,7 @@ cornerHarris :: ByteOrFloat d =>
                 Int -> HIplImage MonoChromatic d -> 
                 HIplImage MonoChromatic Float
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
+{-# INLINE cornerHarris #-}
 
 -- |Harris corner detector. For each pixel, a 2x2 covariance matrix,
 -- @M@, is computed over a @blockSize x blockSize@ neighborhood. The
@@ -39,12 +40,9 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 cornerHarris' :: ByteOrFloat d => 
                  Int -> Int -> Double -> HIplImage MonoChromatic d -> 
                  HIplImage MonoChromatic Float
-cornerHarris' blockSize aperture k src = 
-    unsafePerformIO $ do dst <- mkHIplImage (width src) (height src)
-                         withHIplImage src $ \src' ->
-                           withHIplImage dst $ \dst' ->
-                             harris src' dst' blockSize aperture k
-                         return dst
+cornerHarris' blockSize aperture k = 
+    cv2 $ \src dst -> harris src dst blockSize aperture k
+{-# INLINE cornerHarris' #-}
 
 foreign import ccall unsafe "opencv2/imgprog/imgproc_c.h cvCanny"
   c_cvCanny :: Ptr IplImage -> Ptr IplImage -> CDouble -> CDouble -> CInt -> IO ()
@@ -57,10 +55,8 @@ foreign import ccall unsafe "opencv2/imgprog/imgproc_c.h cvCanny"
 canny :: HasDepth d =>
          Double -> Double -> Int -> HIplImage MonoChromatic d -> 
          HIplImage MonoChromatic d
-canny t1 t2 aperture src = 
-  unsafeWithHIplImage src $ \src' ->
-    fst . withCompatibleImage src $ \dst ->
-          c_cvCanny src' dst (rf t1) (rf t2) (fi aperture)
+canny t1 t2 aperture = 
+    cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
   where rf = realToFrac
         fi = fromIntegral
     
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 89398e5..056d2de 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -3,9 +3,9 @@
 module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian') where
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
-import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
 
@@ -34,7 +34,7 @@ cvGaussian = #{const CV_GAUSSIAN}
 smoothGaussian :: (ByteOrFloat d, HasChannels c) => 
                   Int -> HIplImage c d -> HIplImage c d
 smoothGaussian w = smoothGaussian' w Nothing Nothing
-{-# INLINE [0] smoothGaussian #-}
+{-# INLINE smoothGaussian #-}
 
 -- |Smooth a source 'HIplImage' using a linear convolution with a
 -- Gaussian kernel. Parameters are the kernel width, the kernel height
@@ -45,39 +45,8 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 smoothGaussian' :: (ByteOrFloat d, HasChannels c) => 
                    Int -> Maybe Int -> Maybe Double -> HIplImage c d -> 
                    HIplImage c d
-smoothGaussian' w h sigma src = 
-    unsafePerformIO $
-    withHIplImage src $ \src' ->
-      return . fst . withCompatibleImage src $ \dst ->
-        smooth src' dst cvGaussian w h' sigma' 0
+smoothGaussian' w h sigma = 
+    cv2 $ \src dst -> smooth src dst cvGaussian w h' sigma' 0
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
           h' = case h of { Nothing -> 0; Just jh -> jh }
-{-# INLINE [0] smoothGaussian' #-}
-
-unsafeGaussian'  :: (ByteOrFloat d, HasChannels c) => 
-                    Int -> Maybe Int -> Maybe Double ->
-                    HIplImage c d -> IO (HIplImage c d)
-unsafeGaussian' w h sigma src = withHIplImage src $ \src' ->
-                                  do smooth src' src' cvGaussian w h' sigma' 0
-                                     return src
-    where sigma' = case sigma of
-                     Nothing -> 0
-                     Just s -> realToFrac s
-          h' = case h of { Nothing -> 0; Just jh -> jh }
-{-# INLINE [0] unsafeGaussian' #-}
-
-unsafeGaussian  :: (ByteOrFloat d, HasChannels c) => 
-                    Int -> HIplImage c d -> IO (HIplImage c d)
-unsafeGaussian w = unsafeGaussian' w Nothing Nothing
-{-# INLINE [0] unsafeGaussian #-}
-
-{-# RULES 
-"smoothGaussian'/in-place" [~1] forall w h sigma. 
-  smoothGaussian' w h sigma = pipeline (unsafeGaussian' w h sigma)
-"smoothGaussian'/unpipe" [1] forall w h sigma.
-  pipeline (unsafeGaussian' w h sigma) = smoothGaussian' w h sigma
-"smoothGaussian/in-place" [~1] forall w. 
-  smoothGaussian w = pipeline (unsafeGaussian w)
-"smoothGaussian/unpipe" [1] forall w.
-  pipeline (unsafeGaussian w) = smoothGaussian w
-  #-}
+{-# INLINE smoothGaussian' #-}
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index f2d4f02..e9f41b2 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -6,6 +6,7 @@ import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 
 -- |Flag used to indicate whether pixels under consideration for
 -- addition to a connected component should be compared to the seed
@@ -48,6 +49,7 @@ floodHelper (x,y) newVal loDiff upDiff range src =
 -- pixel; a flag indicating whether pixels under consideration for
 -- painting should be compared to the seed pixel ('FloodFixed') or to
 -- their neighbors ('FloodFloating'); the source image.
+{-
 floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
               IsCvScalar s, s ~ CvScalar c d) => 
              (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
@@ -66,13 +68,13 @@ unsafeFlood seed newVal loDiff upDiff range src =
         do floodHelper seed (toCvScalar newVal) (toCvScalar loDiff) 
                        (toCvScalar upDiff) range ptr
            return src
+-}
+floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
+              IsCvScalar s, s ~ CvScalar c d) => 
+             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
+             HIplImage c d
+floodFill seed newVal loDiff upDiff range = 
+    cv $ floodHelper seed (toCvScalar newVal) (toCvScalar loDiff)
+                     (toCvScalar upDiff) range
 
 {-# INLINE [1] floodFill #-}
-{-# INLINE [1] unsafeFlood #-}
-
-{-# RULES 
-"floodFill/in-place" [~1] forall s nv ld ud r.
-  floodFill s nv ld ud r = pipeline (unsafeFlood s nv ld ud r)
-"floodFill/unpipe" [1] forall s nv ld ud r.
-  pipeline (unsafeFlood s nv ld ud r) = floodFill s nv ld ud r
-  #-}
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index e5eaf26..4f74e38 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -3,27 +3,32 @@
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, HIplImage, width, 
-                            height, pixels, withPixels, fromGrayPixels, 
-                            fromColorPixels, fromFileGray, fromFileColor, 
-                            fromPGM16, toFile, fromPtr, isColor, isMono,
+                            LineType(..), RGB, drawLines, HIplImage, 
+                            width, height, isColor, isMono,
+                            pixels, withPixels, fromGrayPixels, fromColorPixels,
+                            fromFile, fromFileGray, fromFileColor, 
+                            fromPGM16, toFile, fromPtr, 
                             withImagePixels, sampleLine, Connectivity(..), 
-                            fromPixels, cannyEdges, createFileCapture, 
+                            fromPixels, createFileCapture, 
                             createCameraCapture, resize, FourCC, getROI,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, createVideoWriter, HasChannels,
                             module AI.CV.OpenCV.ColorConversion, GrayImage,
                             ColorImage, GrayImage16, createFileCaptureLoop, 
                             HasDepth, module AI.CV.OpenCV.Threshold,
-                            module AI.CV.OpenCV.FloodFill)
+                            module AI.CV.OpenCV.FloodFill,
+                            module AI.CV.OpenCV.FeatureDetection,
+                            runWindow)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
-import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, 
+import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, cvInit,
                                   setCapturePos, CapturePos(PosFrames), 
                                   CvCapture, createCameraCaptureF, 
-                                  createVideoWriterF, cvWriteFrame, FourCC)
+                                  createVideoWriterF, cvWriteFrame, FourCC,
+                                  newWindow, delWindow, showImage, cvWaitKey)
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 import AI.CV.OpenCV.ColorConversion
 --import AI.CV.OpenCV.Contours
 import Data.Word (Word8, Word16)
@@ -31,9 +36,9 @@ import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
-import Unsafe.Coerce
 import AI.CV.OpenCV.Threshold
 import AI.CV.OpenCV.FloodFill
+import AI.CV.OpenCV.FeatureDetection
 
 -- |Grayscale 8-bit (per-pixel) image type.
 type GrayImage = HIplImage MonoChromatic Word8
@@ -48,48 +53,15 @@ type ColorImage = HIplImage TriChromatic Word8
 -- specified number of iterations.
 erode :: (HasChannels c, HasDepth d) =>
          Int -> HIplImage c d -> HIplImage c d
-erode n img = unsafePerformIO . withHIplImage img $
-              \src -> return . fst . withCompatibleImage img $
-                      \dst -> cvErode src dst n'
-    where n' = fromIntegral n
-{-# INLINE [0] erode #-}
+erode n = cv2 $ \src dst -> cvErode src dst (fromIntegral n)
+{-# INLINE erode #-}
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 dilate :: (HasChannels c, HasDepth d) =>
           Int -> HIplImage c d -> HIplImage c d
-dilate n img = unsafePerformIO . withHIplImage img $
-               \src -> return . fst . withCompatibleImage img $
-                       \dst -> cvDilate src dst n'
-    where n' = fromIntegral n
-{-# INLINE [0] dilate #-}
-
--- |Unsafe in-place erosion. This is a destructive update of the given
--- image and is only used by the rewrite rules when there is no way to
--- observe the input image.
-unsafeErode :: (HasChannels c, HasDepth d) => 
-               Int -> HIplImage c d -> IO (HIplImage c d)
-unsafeErode n img = withHIplImage img (\src -> cvErode src src n') >> 
-                    return (unsafeCoerce img)
-    where n' = fromIntegral n
-{-# INLINE [0] unsafeErode #-}
-
--- |Unsafe in-place dilation. This is a destructive update of the
--- given image and is only used by the rewrite rules when there is no
--- way to observe the input image.
-unsafeDilate :: (HasChannels c, HasDepth d) =>
-                Int -> HIplImage c d-> IO (HIplImage c d)
-unsafeDilate n img = withHIplImage img (\src -> cvDilate src src n') >> 
-                     return (unsafeCoerce img)
-    where n' = fromIntegral n
-{-# INLINE [0] unsafeDilate #-}
-
-{-# RULES 
-"erode/in-place" [~1] forall n. erode n = pipeline (unsafeErode n)
-"erode/unpipe" [1] forall n. pipeline (unsafeErode n) = erode n
-"dilate/in-place" [~1] forall n. dilate n = pipeline (unsafeDilate n)
-"dilate/unpipe" [1] forall n. pipeline (unsafeDilate n) = dilate n
-  #-}
+dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
+{-# INLINE dilate #-}
 
 -- |Extract all the pixel values from an image along a line, including
 -- the end points. Parameters are the two endpoints, the line
@@ -99,6 +71,7 @@ sampleLine :: (HasChannels c, HasDepth d) =>
               (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage c d -> [d]
 sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $ 
                                 \p -> cvSampleLine p pt1 pt2 conn
+{-# NOINLINE sampleLine #-}
 
 -- |Line detection in a binary image using a standard Hough
 -- transform. Parameters are @rho@, the distance resolution in
@@ -128,6 +101,7 @@ houghStandard rho theta threshold img = unsafePerformIO $
                                    in ((x1,y1),(x2,y2))
           clampX x = max 0 (min (truncate x) (width img - 1))
           clampY y = max 0 (min (truncate y) (height img - 1))
+{-# NOINLINE houghStandard #-}
 
 -- |Line detection in a binary image using a probabilistic Hough
 -- transform. Parameters are @rho@, the distance resolution in pixels;
@@ -138,9 +112,9 @@ houghProbabilistic :: Double -> Double -> Int -> Double -> Double ->
 houghProbabilistic rho theta threshold minLength maxGap img = 
     unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
-       let cvSeq = snd $ withDuplicateImage img $
-                     \p -> cvHoughLines2 p storage 1 rho theta threshold
-                                         minLength maxGap
+       cvSeq <- fmap snd . withDuplicateImage img $
+                  \p -> cvHoughLines2 p storage 1 rho theta threshold
+                                      minLength maxGap
        hlines <- mapM (\p1 -> do x1 <- peek p1
                                  let p2 = plusPtr p1 step
                                      p3 = plusPtr p2 step
@@ -153,6 +127,7 @@ houghProbabilistic rho theta threshold minLength maxGap img =
        cvReleaseMemStorage storage
        return hlines
     where step = sizeOf (undefined::Int)
+{-# NOINLINE houghProbabilistic #-}
 
 -- |Type of line to draw.
 data LineType = EightConn -- ^8-connected line
@@ -174,58 +149,11 @@ lineTypeEnum AALine    = 16
 drawLines :: (HasChannels c, HasDepth d) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
              HIplImage c d -> HIplImage c d
-drawLines col thick lineType lines img = 
-    fst $ withDuplicateImage img $ \ptr -> mapM_ (draw ptr) lines
+drawLines col thick lineType lines = 
+    cv $ \img -> mapM_ (draw img) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
-{-# INLINE [0] drawLines #-}
-
--- |Unsafe in-place line drawing.
-unsafeDrawLines :: (HasChannels c, HasDepth d) =>
-                   RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-                   HIplImage c d -> IO (HIplImage c d)
-unsafeDrawLines col thick lineType lines img = 
-    withHIplImage img $ \ptr -> 
-      mapM_ (draw ptr) lines >> return (unsafeCoerce img)
-    where draw ptr (pt1,pt2) = cvLine ptr pt1 pt2 col thick lineType'
-          lineType' = lineTypeEnum lineType
-{-# INLINE [0] unsafeDrawLines #-}
-
-{-# RULES 
-"drawLines/in-place" [~1] forall c t lt lns. 
-  drawLines c t lt lns = pipeline (unsafeDrawLines c t lt lns)
-"drawLines/unpipe" [1] forall c t lt lns.
-  pipeline (unsafeDrawLines c t lt lns) = drawLines c t lt lns
-  #-}
-
--- |Find edges using the Canny algorithm. The smallest value between
--- threshold1 and threshold2 (the first two parameters, respectively)
--- is used for edge linking, the largest value is used to find the
--- initial segments of strong edges. The third parameter is the
--- aperture parameter for the Sobel operator.
-cannyEdges :: HasDepth d =>
-              Double -> Double -> Int -> HIplImage MonoChromatic d -> 
-              HIplImage MonoChromatic d
-cannyEdges threshold1 threshold2 aperture img = 
-    fst . withCompatibleImage img $ \dst -> 
-        withHIplImage img $ \src -> 
-            cvCanny src dst threshold1 threshold2 aperture
-{-# INLINE [0] cannyEdges #-}
-
-unsafeCanny :: HasDepth d =>
-               Double -> Double -> Int -> HIplImage MonoChromatic d -> 
-               IO (HIplImage MonoChromatic d)
-unsafeCanny threshold1 threshold2 aperture img = 
-    withHIplImage img $ \src -> 
-        cvCanny src src threshold1 threshold2 aperture >> return img
-{-# INLINE [0] unsafeCanny #-}
-
-{-# RULES 
-"canny/in-place" [~1] forall t1 t2 a.
-  cannyEdges t1 t2 a = pipeline (unsafeCanny t1 t2 a)
-"canny/unpipe" [1] forall t1 t2 a.
-  pipeline (unsafeCanny t1 t2 a) = cannyEdges t1 t2 a
-  #-}
+{-# INLINE drawLines #-}
 
 {-
 -- |Find the 'CvContour's in an image.
@@ -279,7 +207,8 @@ createFileCaptureLoop fname = do capture <- createFileCaptureF fname
 -- query for the next available frame.
 createCameraCapture :: (HasChannels c, HasDepth d) =>
                        Maybe Int -> IO (IO (HIplImage c d))
-createCameraCapture cam = do capture <- createCameraCaptureF cam'
+createCameraCapture cam = do cvInit
+                             capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
                                      (>>= fromPtr) . queryError)
     where cam' = maybe (-1) id cam
@@ -299,6 +228,12 @@ createVideoWriter fname codec fps sz =
                                 cvWriteFrame writer' img'
        return writeFrame
 
+-- FIXME: There is no fusion mechanism that can handle 'resize'. The
+-- problem is that the fusion combinators assume the output image is
+-- the same size as the input image as this information is not
+-- captured in the type. That said, it would be nice to be able to do
+-- in-place updates to the output of 'resize'.
+
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
 resize :: (HasChannels c, HasDepth d) => 
@@ -310,3 +245,13 @@ resize method w h img =
               withHIplImage img' $ \dst ->
                 cvResize src dst method
        return img'
+{-# NOINLINE resize #-}
+
+--runWindow :: (HasChannels c, HasDepth d) => IO (HIplImage c d) -> IO ()
+runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
+runWindow mkImg = go
+    where go = do newWindow 0 True
+                  mkImg >>= flip withHIplImage (showImage 0)
+                  cvWaitKey 30 >>= bool (delWindow 0) go . (> 0)
+          bool t _ True = t
+          bool _ f False = f
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index 34ea46d..d35da2d 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -65,7 +65,7 @@ isolateChannel ch img =
 {-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> IO (V.Vector d)
-toMono img = if imgChannels img == 1 then return $ packPixels img
-             else fmap packPixels (convertRGBToGray . isColor $ unsafeCoerce img)
+toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> V.Vector d
+toMono img = if imgChannels img == 1 then packPixels img
+             else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
 
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
new file mode 100644
index 0000000..8fed0cf
--- /dev/null
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -0,0 +1,20 @@
+import AI.CV.OpenCV.HighCV
+import AI.CV.OpenCV.ArrayOps
+import AI.CV.OpenCV.Filtering
+import Control.Applicative
+import Control.Parallel
+
+main2 = createCameraCapture (Just 0) >>= runWindow . fmap proc
+    where proc = canny 50 90 3 . convertRGBToGray
+
+main1 = createCameraCapture (Just 0) >>= runWindow . fmap (cvAdd <$> id <*> proc)
+    where proc = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
+               . canny 50 90 3 . convertRGBToGray
+
+main = createCameraCapture (Just 0) >>= runWindow . fmap proc
+    where proc x = let e = edges x 
+                       s = smooth x
+                   in e `par` s `pseq` cvAdd e s
+          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
+                . canny 50 90 3 . convertRGBToGray
+          smooth = smoothGaussian 25

From fe5519838491d62b0e31fcf35a0cf1eaddb81c32 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 26 May 2011 01:29:25 -0400
Subject: [PATCH 074/137] Changed FFI calls to safe.

---
 HOpenCV.cabal                        |  4 +--
 src/AI/CV/OpenCV/ArrayOps.hs         |  2 +-
 src/AI/CV/OpenCV/Core/CV.hsc         |  4 +--
 src/AI/CV/OpenCV/Core/CxCore.hsc     |  6 +++-
 src/AI/CV/OpenCV/Core/HIplImage.hsc  |  3 +-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c | 14 +++++++++
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h |  3 ++
 src/AI/CV/OpenCV/Drawing.hs          | 43 ++++++++++++++++++++++++++++
 src/AI/CV/OpenCV/FeatureDetection.hs |  2 +-
 src/AI/CV/OpenCV/Filtering.hsc       |  2 +-
 src/AI/CV/OpenCV/HighCV.hs           | 34 +++-------------------
 src/Examples/CamCanny/CamCanny.hs    | 39 ++++++++++++++++++++++++-
 12 files changed, 116 insertions(+), 40 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/Drawing.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index e919636..0ec3e60 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -47,7 +47,7 @@ library
       AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-   other-modules: AI.CV.OpenCV.Core.CVOp
+   other-modules: AI.CV.OpenCV.Core.CVOp AI.CV.OpenCV.Drawing
    hs-Source-Dirs: src
    if os(windows)
      include-dirs: C:\\OpenCV2.1\\include
@@ -61,4 +61,4 @@ library
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
                   vector == 0.7.*
-   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing
+   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -O3 -funbox-strict-fields
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 215c7c5..8da87f8 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -88,7 +88,7 @@ cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' ->
              cvAndHelper src1' src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvAndS"
+foreign import ccall safe "opencv2/core/core_c.h cvAndS"
    c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
index 4e26477..618c861 100644
--- a/src/AI/CV/OpenCV/Core/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -44,7 +44,7 @@ foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvResize"
 cvResize :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> InterpolationMethod -> IO ()
 cvResize src dst interp = c_cvResize (fromArr src) (fromArr dst) (fromIntegral . fromEnum $ interp)
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvDilate"
+foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvDilate"
   c_dilate :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
 -- |Dilate the first image using a 3x3 rectangular structuring element
@@ -71,7 +71,7 @@ cvHoughLines2 img storage method rho theta threshold param1 param2 =
                     (realToFrac theta) (fromIntegral threshold) 
                     (realToFrac param1) (realToFrac param2)
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCvtColor"
+foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvCvtColor"
   c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSampleLine"
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index ae27cb0..3809a5f 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -308,7 +308,7 @@ foreign import ccall unsafe "HOpenCV_wrap.h c_cvLine"
                     CDouble -> CDouble -> CDouble -> CInt -> 
                     CInt -> CInt -> IO ()
 
-cvLine :: IplArrayType a => Ptr a -> (Int, Int)  -> (Int, Int) -> 
+cvLine :: IplArrayType a => Ptr a -> (Int, Int) -> (Int, Int) -> 
                     (Double, Double, Double) -> Int -> 
                     Int -> IO ()
 cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
@@ -317,6 +317,10 @@ cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
         where fi = fromIntegral
               fr = realToFrac
 
+foreign import ccall unsafe "HOpenCV_wrap.h c_cvPutText"
+  c_cvPutText :: Ptr CvArr -> CString -> CInt -> CInt -> 
+                 CDouble -> CDouble -> CDouble -> IO ()
+
 -- |Convert null pointers to 'Nothing' and non-null pointers to 'Just'
 -- values.
 ptrToMaybe :: Ptr a -> Maybe (Ptr a)
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 7d98061..75bac29 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,5 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
-             TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs #-}
+             TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
+             BangPatterns #-}
 module AI.CV.OpenCV.Core.HIplImage 
     ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index 9c2b29d..dbf906d 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -149,6 +149,20 @@ void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g,
            lineType, shift);
 }
 
+CvFont defaultFont;
+unsigned char defaultFontInitialized = 0;
+
+void c_cvPutText(CvArr *img, const char* msg, int x, int y, 
+                 double r, double g, double b)
+{
+  if(!defaultFontInitialized)
+  {
+    cvInitFont(&defaultFont, CV_FONT_HERSHEY_SIMPLEX, 1.0, 1.0, 0.0, 1, 8);
+    defaultFontInitialized = 1;
+  }
+  cvPutText(img, msg, cvPoint(x,y), &defaultFont, CV_RGB(r,g,b));
+}
+
 int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, 
                      int header_size, int mode, int method, int offset_x, 
                      int offset_y)
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 5108abc..3f9d181 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -31,6 +31,9 @@ void c_cvRectangle(CvArr *img, int x, int y, int width, int height);
 void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
               double b, int thickness, int lineType, int shift);
 
+void c_cvPutText(CvArr *img, const char* msg, int x, int y, 
+                 double r, double g, double b);
+
 int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, 
                      int header_size, int mode, int method, int offset_x, 
                      int offset_y);
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
new file mode 100644
index 0000000..9ec3de4
--- /dev/null
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -0,0 +1,43 @@
+module AI.CV.OpenCV.Drawing where
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
+import Foreign.C.String
+import Foreign.Ptr
+
+putText :: (HasChannels c, HasDepth d) => 
+           String -> (Int,Int) -> (Double,Double,Double) -> 
+           HIplImage c d -> HIplImage c d
+putText msg (x,y) (r,g,b) = cv $ \dst ->
+                            withCString msg $ \msg' ->
+                                c_cvPutText (castPtr dst) msg' (fi x) (fi y) 
+                                            (fr r) (fr g) (fr b)
+    where fi = fromIntegral
+          fr = realToFrac
+{-# INLINE putText #-}
+
+-- |Type of line to draw.
+data LineType = EightConn -- ^8-connected line
+              | FourConn  -- ^4-connected line
+              | AALine    -- ^antialiased line
+
+-- |An RGB triple. 
+type RGB = (Double, Double, Double)
+
+-- |Convert a LineType into an integer.
+lineTypeEnum :: LineType -> Int
+lineTypeEnum EightConn = 8
+lineTypeEnum FourConn  = 4
+lineTypeEnum AALine    = 16
+
+-- |Draw each line, defined by its endpoints, on a duplicate of the
+-- given 'HIplImage' using the specified RGB color, line thickness,
+-- and aliasing style.
+drawLines :: (HasChannels c, HasDepth d) =>
+             RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
+             HIplImage c d -> HIplImage c d
+drawLines col thick lineType lines = 
+    cv $ \img -> mapM_ (draw img) lines
+    where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
+          lineType' = lineTypeEnum lineType
+{-# INLINE drawLines #-}
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 2fbd388..f173177 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -44,7 +44,7 @@ cornerHarris' blockSize aperture k =
     cv2 $ \src dst -> harris src dst blockSize aperture k
 {-# INLINE cornerHarris' #-}
 
-foreign import ccall unsafe "opencv2/imgprog/imgproc_c.h cvCanny"
+foreign import ccall safe "opencv2/imgprog/imgproc_c.h cvCanny"
   c_cvCanny :: Ptr IplImage -> Ptr IplImage -> CDouble -> CDouble -> CInt -> IO ()
 
 -- |Canny edge detector. @canny threshold1 threshold2 aperture src@
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 056d2de..b8197b8 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -9,7 +9,7 @@ import AI.CV.OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSmooth"
+foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvSmooth"
   c_cvSmooth :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> CDouble -> 
                 CDouble -> IO ()
 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 4f74e38..4c6b5ba 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -3,8 +3,7 @@
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
 module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            LineType(..), RGB, drawLines, HIplImage, 
-                            width, height, isColor, isMono,
+                            HIplImage, width, height, isColor, isMono,
                             pixels, withPixels, fromGrayPixels, fromColorPixels,
                             fromFile, fromFileGray, fromFileColor, 
                             fromPGM16, toFile, fromPtr, 
@@ -18,7 +17,7 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             HasDepth, module AI.CV.OpenCV.Threshold,
                             module AI.CV.OpenCV.FloodFill,
                             module AI.CV.OpenCV.FeatureDetection,
-                            runWindow)
+                            runWindow, module AI.CV.OpenCV.Drawing)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
@@ -27,6 +26,7 @@ import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, cvInit,
                                   CvCapture, createCameraCaptureF, 
                                   createVideoWriterF, cvWriteFrame, FourCC,
                                   newWindow, delWindow, showImage, cvWaitKey)
+import AI.CV.OpenCV.Drawing
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 import AI.CV.OpenCV.ColorConversion
@@ -129,32 +129,6 @@ houghProbabilistic rho theta threshold minLength maxGap img =
     where step = sizeOf (undefined::Int)
 {-# NOINLINE houghProbabilistic #-}
 
--- |Type of line to draw.
-data LineType = EightConn -- ^8-connected line
-              | FourConn  -- ^4-connected line
-              | AALine    -- ^antialiased line
-
--- |An RGB triple. 
-type RGB = (Double, Double, Double)
-
--- |Convert a LineType into an integer.
-lineTypeEnum :: LineType -> Int
-lineTypeEnum EightConn = 8
-lineTypeEnum FourConn  = 4
-lineTypeEnum AALine    = 16
-
--- |Draw each line, defined by its endpoints, on a duplicate of the
--- given 'HIplImage' using the specified RGB color, line thickness,
--- and aliasing style.
-drawLines :: (HasChannels c, HasDepth d) =>
-             RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-             HIplImage c d -> HIplImage c d
-drawLines col thick lineType lines = 
-    cv $ \img -> mapM_ (draw img) lines
-    where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
-          lineType' = lineTypeEnum lineType
-{-# INLINE drawLines #-}
-
 {-
 -- |Find the 'CvContour's in an image.
 findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
@@ -252,6 +226,6 @@ runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
 runWindow mkImg = go
     where go = do newWindow 0 True
                   mkImg >>= flip withHIplImage (showImage 0)
-                  cvWaitKey 30 >>= bool (delWindow 0) go . (> 0)
+                  cvWaitKey 1 >>= bool (delWindow 0) go . (> 0)
           bool t _ True = t
           bool _ f False = f
\ No newline at end of file
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
index 8fed0cf..b999232 100644
--- a/src/Examples/CamCanny/CamCanny.hs
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -3,18 +3,55 @@ import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
 import Control.Applicative
 import Control.Parallel
+import Data.IORef
+import Text.Printf
+import Data.Time.Clock
 
+-- Just real-time edges
 main2 = createCameraCapture (Just 0) >>= runWindow . fmap proc
     where proc = canny 50 90 3 . convertRGBToGray
 
+-- Thick red edges added to raw video
 main1 = createCameraCapture (Just 0) >>= runWindow . fmap (cvAdd <$> id <*> proc)
     where proc = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
                . canny 50 90 3 . convertRGBToGray
 
-main = createCameraCapture (Just 0) >>= runWindow . fmap proc
+trackRate :: IO (IO String)
+trackRate = do numFrames <- newIORef 0
+               oldRate <- newIORef ""
+               startTime <- getCurrentTime >>= newIORef
+               return $ do n <- readIORef numFrames
+                           if n == 30 then
+                             do t <- getCurrentTime
+                                s <- readIORef startTime
+                                let dt = realToFrac $ diffUTCTime t s :: Float
+                                    msg = printf "%.2f" (30.0 / dt)
+                                writeIORef startTime t
+                                writeIORef numFrames 0
+                                writeIORef oldRate msg
+                                return msg
+                           else
+                             do writeIORef numFrames (n+1)
+                                readIORef oldRate
+
+-- Thick red edges added to smoothed video (parallelism!).
+main3 = createCameraCapture (Just 0) >>= runWindow . fmap proc
     where proc x = let e = edges x 
                        s = smooth x
                    in e `par` s `pseq` cvAdd e s
           edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
                 . canny 50 90 3 . convertRGBToGray
           smooth = smoothGaussian 25
+
+-- Thick red edges added to smoothed video with framerate display.
+main = do rater <- trackRate
+          cam <- createCameraCapture (Just 0)
+          runWindow $ do msg <- rater
+                         proc msg <$> cam
+    where proc msg x = let e = edges x 
+                           s = smooth x
+                       in e `par` s `pseq` showFPS msg (cvAdd e s)
+          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
+                . canny 50 90 3 . convertRGBToGray
+          smooth = smoothGaussian 25
+          showFPS s = putText (s++" FPS") (300,450) (0,255,0)

From ea112d1c3557b2ec562516f3e5ca982d8d48bb9b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 26 May 2011 02:33:49 -0400
Subject: [PATCH 075/137] Fixed fusion of convertScale. Made cvSubMask
 confusing to use but more likely to provide useful fusion.

---
 src/AI/CV/OpenCV/ArrayOps.hs | 64 ++++++++++++++++++++++++------------
 1 file changed, 43 insertions(+), 21 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 8da87f8..9f474c6 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -2,16 +2,16 @@
 -- |Array operations.
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
                               cvAnd, cvAndMask, cvScaleAdd, cvAndS,
-                              cvMul, cvMul', cvAdd, cvAddS) where
+                              cvMul, cvMul', cvAdd, cvAddS, cvSub,
+                              cvSubMask) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvSubRS"
+foreign import ccall "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -24,7 +24,7 @@ subRS value = cv2 $ \src dst ->
     where (r,g,b,a) = toCvScalar value
 {-# INLINE subRS #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvAbsDiff"
+foreign import ccall "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
@@ -35,7 +35,7 @@ absDiff src1 = cv2 $ \src2 dst ->
                  c_cvAbsDiff (castPtr src1') (castPtr src2) (castPtr dst)
 {-# INLINE absDiff #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvConvertScale"
+foreign import ccall "opencv2/core/core_c.h cvConvertScale"
   c_cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
 
 -- |Converts one array to another with optional affine
@@ -48,18 +48,14 @@ foreign import ccall unsafe "opencv2/core/core_c.h cvConvertScale"
 convertScale :: (HasChannels c, HasDepth d1, HasDepth d2) =>
                 Double -> Double -> HIplImage c d1 -> 
                 HIplImage c d2
-convertScale scale shift src = unsafePerformIO $
-                               do dst <- mkHIplImage (width src) (height src)
-                                  withHIplImage src $ \src' ->
-                                    withHIplImage dst $ \dst' ->
-                                      c_cvConvertScale (castPtr src') 
-                                                       (castPtr dst') 
-                                                       (realToFrac scale) 
-                                                       (realToFrac shift)
-                                  return dst
-{-# NOINLIN convertScale #-}
-
-foreign import ccall unsafe "opencv2/core/core_c.h cvAnd"
+convertScale scale shift  = cv2 $ \src dst ->
+                            c_cvConvertScale (castPtr src) 
+                                             (castPtr dst) 
+                                             (realToFrac scale) 
+                                             (realToFrac shift)
+{-# INLINE convertScale #-}
+
+foreign import ccall "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 cvAndHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> 
@@ -101,7 +97,7 @@ cvAndS s = cv2 $ \img dst ->
     where (r,g,b,a) = toCvScalar s
 {-# INLINE cvAndS #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvScaleAdd"
+foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                   Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -115,7 +111,7 @@ cvScaleAdd src1 s = cv2 $ \src2 dst ->
     where (r,g,b,a) = toCvScalar s
 {-# INLINE cvScaleAdd #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvMul"
+foreign import ccall "opencv2/core/core_c.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
 
 cvMulHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
@@ -139,7 +135,7 @@ cvMul' scale src1 = cv2 $ \src2 dst ->
                         cvMulHelper src1' src2 dst scale
 {-# INLINE cvMul' #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvAdd"
+foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum of two arrays.
@@ -150,7 +146,7 @@ cvAdd src1 = cv2 $ \src2 dst ->
                  c_cvAdd (castPtr src1') (castPtr src2) (castPtr dst) nullPtr
 {-# INLINE cvAdd #-}
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvAddS"
+foreign import ccall "opencv2/core/core_c.h cvAddS"
   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
               Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -160,3 +156,29 @@ cvAddS scalar = cv2 $ \src dst ->
                 c_cvAddS (castPtr src) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE cvAddS #-}
+
+foreign import ccall "opencv2/core/core_c.h cvSub"
+  c_cvSub :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+cvSub :: (HasChannels c, HasDepth d) =>
+         HIplImage c d -> HIplImage c d -> HIplImage c d
+cvSub img1 = cv2 $ \img2 dst ->
+             withHIplImage img1 $ \img1' -> 
+                 c_cvSub (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
+{-# INLINE cvSub #-}
+
+-- FIXME: This isn't really what one typically wants. If a mask is
+-- given, the destination array should be a clone of img1, which makes
+-- composition hard.
+
+-- |WARNING: Argument order is reversed here! @cvSubMask img2 mask
+-- img1@ computes @dest[i] = img1[i] - img2[i] if mask[i]@.
+cvSubMask :: (HasChannels c, HasDepth d) =>
+             HIplImage c d -> HIplImage MonoChromatic Word8 -> HIplImage c d -> 
+             HIplImage c d
+cvSubMask img2 mask = cv $ \img1 ->
+                      withHIplImage mask $ \mask' -> 
+                          withHIplImage img2 $ \img2' ->
+                              c_cvSub (castPtr img1) (castPtr img2') 
+                                      (castPtr img1) (castPtr mask')
+{-# INLINE cvSubMask #-}
\ No newline at end of file

From 4aba6203a8ed34af8e5de3a8e211d79eb2651c8d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 26 May 2011 02:34:21 -0400
Subject: [PATCH 076/137] Updated Threshold module with CVOp.

---
 src/AI/CV/OpenCV/Threshold.hs     | 202 +++++-------------------------
 src/Examples/CamCanny/CamCanny.hs |   6 +
 src/Examples/CamCanny/Makefile    |   4 +
 3 files changed, 40 insertions(+), 172 deletions(-)
 create mode 100644 src/Examples/CamCanny/Makefile

diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index cf98621..e29f429 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -7,15 +7,15 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdTruncate, 
                                thresholdToZero, thresholdToZeroInv,
                                thresholdBinaryOtsu, thresholdBinaryOtsuInv,
-                               thresholdTruncateOtsu, unsafeThreshBin,
+                               thresholdTruncateOtsu,
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr)
-import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
 
 data ThresholdType = ThreshBinary
                    | ThreshBinaryInv
@@ -40,56 +40,33 @@ foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvThreshold"
 -- The worker function that calls c_cvThreshold.
 cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-               (HIplImage MonoChromatic d2, d1)
-cvThreshold threshold maxValue tType src = 
-    unsafePerformIO $
-    withHIplImage src $ \srcPtr ->
-        do dst <- mkHIplImage (width src) (height src)
-           r <- withHIplImage dst $ \dstPtr ->
-                  c_cvThreshold (castPtr srcPtr) (castPtr dstPtr) 
-                                threshold' maxValue' tType'
-           return (dst, fromDouble (realToFrac r))
+               HIplImage MonoChromatic d2
+cvThreshold threshold maxValue tType = 
+    cv2 $ \src dst ->
+        do _r <- c_cvThreshold (castPtr src) (castPtr dst) 
+                               threshold' maxValue' tType'
+           return ()
+           --return (fromDouble (realToFrac r)) -- FIXME: This is dropped by cv2!
     where threshold' = realToFrac . toDouble $ threshold
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
+{-# INLINE cvThreshold #-}
 
 cvThreshold1 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
                HIplImage MonoChromatic d2
-cvThreshold1 threshold maxValue tType src = 
-    fst $ cvThreshold threshold maxValue tType src
-
-unsafeCvThreshold :: ByteOrFloat d1 =>
-                     d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-                     IO (HIplImage MonoChromatic d1, d1)
-unsafeCvThreshold threshold maxValue tType src = 
-    withHIplImage src $ \srcPtr ->
-      do r <- c_cvThreshold (castPtr srcPtr) (castPtr srcPtr) 
-                             threshold' maxValue' tType'
-         return (src, fromDouble (realToFrac r))
-    where threshold' = realToFrac . toDouble $ threshold
-          maxValue' = realToFrac . toDouble $ maxValue
-          tType' = fromIntegral tType
-
-unsafeCvThreshold1 :: ByteOrFloat d1 =>
-                      d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-                      IO (HIplImage MonoChromatic d1)
-unsafeCvThreshold1 th mv tt = fmap fst . unsafeCvThreshold th mv tt
+cvThreshold1 threshold maxValue tType = 
+    cvThreshold threshold maxValue tType
+{-# INLINE cvThreshold1 #-}
 
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
 cvThresholdOtsu :: Word8 -> Int -> HIplImage MonoChromatic Word8 ->
-                   (HIplImage MonoChromatic Word8, Word8)
+                   HIplImage MonoChromatic Word8
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
-
-unsafeCvThresholdOtsu :: Word8 -> Int -> 
-                         HIplImage MonoChromatic Word8 ->
-                         IO (HIplImage MonoChromatic Word8, Word8)
-unsafeCvThresholdOtsu maxValue tType = unsafeCvThreshold 0 maxValue tType'
-    where otsu = 8
-          tType' = tType .|. otsu
+{-# INLINE cvThresholdOtsu #-}
 
 -- |Binary thresholding. Parameters are the @threshold@ value, the
 -- @maxValue@ passing pixels are mapped to, and the source
@@ -99,7 +76,7 @@ thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
-{-# INLINE [1] thresholdBinary #-}
+{-# INLINE thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
 -- the @maxValue@ passing pixels are mapped to, and the source
@@ -110,30 +87,7 @@ thresholdBinaryInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                       HIplImage MonoChromatic d2
 thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
     where tType = fromEnum ThreshBinaryInv
-
-unsafeThreshBin :: ByteOrFloat d =>
-                   d -> d -> HIplImage MonoChromatic d ->
-                   IO (HIplImage MonoChromatic d)
-unsafeThreshBin th maxValue = unsafeCvThreshold1 th maxValue tType
-    where tType = fromEnum ThreshBinary
-{-# INLINE [1] unsafeThreshBin #-}
-
-unsafeThreshBinInv :: ByteOrFloat d =>
-                      d -> d -> HIplImage MonoChromatic d ->
-                      IO (HIplImage MonoChromatic d)
-unsafeThreshBinInv th maxValue = unsafeCvThreshold1 th maxValue tType
-    where tType = fromEnum ThreshBinaryInv
-
-{-# RULES 
-"thresholdBinary/in-place" [~1] forall th mv.
-  thresholdBinary th mv = pipeline (unsafeThreshBin th mv)
-"thresholdBinary/unpipe" [1] forall th mv.
-  pipeline (unsafeThreshBin th mv) = thresholdBinary th mv
-"thresholdBinaryInv/in-place" [~1] forall th mv. 
-  thresholdBinaryInv th mv = pipeline (unsafeThreshBinInv th mv)
-"thresholdBinaryInv/unpipe" [1] forall th mv.
-  pipeline (unsafeThreshBinInv th mv) = thresholdBinaryInv th mv
-  #-}
+{-# INLINE thresholdBinaryInv #-}
 
 -- |Truncation thresholding (i.e. clamping). Parameters are the
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
@@ -143,20 +97,7 @@ thresholdTruncate :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                      d1 -> HIplImage MonoChromatic d1 ->
                      HIplImage MonoChromatic d2
 thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
-
-unsafeThreshTrunc :: ByteOrFloat d1 =>
-                     d1 -> HIplImage MonoChromatic d1 ->
-                     IO (HIplImage MonoChromatic d1)
-unsafeThreshTrunc th = unsafeCvThreshold1 th 0 (fromEnum ThreshTrunc)
-
-{-# INLINE [0] thresholdTruncate #-}
-{-# INLINE [0] unsafeThreshTrunc #-}
-{-# RULES 
-"thresholdTruncate/in-place" [~1] forall th. 
-  thresholdTruncate th = pipeline (unsafeThreshTrunc th)
-"thresholdTruncate/unpipe" [1] forall th.
-  pipeline (unsafeThreshTrunc th) = thresholdTruncate th
-  #-}
+{-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
@@ -165,6 +106,7 @@ thresholdToZero :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
 thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
+{-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
@@ -174,42 +116,17 @@ thresholdToZeroInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                       HIplImage MonoChromatic d2
 thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
-
-unsafeThresholdToZero :: ByteOrFloat d => 
-                         d -> HIplImage MonoChromatic d ->
-                         IO (HIplImage MonoChromatic d)
-unsafeThresholdToZero th = unsafeCvThreshold1 th 0 tType
-    where tType = fromEnum ThreshToZero
-
-unsafeThresholdToZeroInv :: ByteOrFloat d => 
-                            d -> HIplImage MonoChromatic d ->
-                            IO (HIplImage MonoChromatic d)
-unsafeThresholdToZeroInv th = unsafeCvThreshold1 th 0 tType
-    where tType = fromEnum ThreshToZeroInv
-
-{-# INLINE [0] thresholdToZero #-}
-{-# INLINE [0] unsafeThresholdToZero #-}
-{-# INLINE [0] thresholdToZeroInv #-}
-{-# INLINE [0] unsafeThresholdToZeroInv #-}
-{-# RULES 
-"thresholdToZero/in-place" [~1] forall th. 
-  thresholdToZero th = pipeline (unsafeThresholdToZero th)
-"thresholdToZero/unpipe" [1] forall th.
-  pipeline (unsafeThresholdToZero th) = thresholdToZero th
-"thresholdToZeroInv/in-place" [~1] forall th. 
-  thresholdToZeroInv th = pipeline (unsafeThresholdToZeroInv th)
-"thresholdToZeroInv/unpipe" [1] forall th.
-  pipeline (unsafeThresholdToZeroInv th) = thresholdToZeroInv th
-  #-}
+{-# INLINE thresholdToZeroInv #-}
 
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'.
 thresholdBinaryOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
-                       (HIplImage MonoChromatic Word8, Word8)
+                       HIplImage MonoChromatic Word8
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
+{-# INLINE thresholdBinaryOtsu #-}
 
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
@@ -217,91 +134,32 @@ thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
 -- the threshold with and the source 'HIplImage'. The sense of the
 -- thresholding operation is inverted, as in 'thresholdBinaryInv'.
 thresholdBinaryOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
-                          (HIplImage MonoChromatic Word8, Word8)
+                          HIplImage MonoChromatic Word8
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
-
-unsafeBinOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
-                 IO (HIplImage MonoChromatic Word8, Word8)
-unsafeBinOtsu maxValue = unsafeCvThresholdOtsu maxValue tType
-    where tType = fromEnum ThreshBinary
-
-unsafeBinOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
-                    IO (HIplImage MonoChromatic Word8, Word8)
-unsafeBinOtsuInv maxValue = unsafeCvThresholdOtsu maxValue tType
-    where tType = fromEnum ThreshBinaryInv
-
-{-# INLINE [0] thresholdBinaryOtsu #-}
-{-# INLINE [0] unsafeBinOtsu #-}
-{-# INLINE [0] thresholdBinaryOtsuInv #-}
-{-# INLINE [0] unsafeBinOtsuInv #-}
-{-# RULES 
-"thresholdBinaryOtsu/in-place" [~1] forall mv. 
-  thresholdBinaryOtsu mv = pipeline (unsafeBinOtsu mv)
-"thresholdBinaryOtsu/unpipe" [1] forall mv.
-  pipeline (unsafeBinOtsu mv) = thresholdBinaryOtsu mv
-"thresholdBinaryOtsuInv/in-place" [~1] forall mv. 
-  thresholdBinaryOtsuInv mv = pipeline (unsafeBinOtsuInv mv)
-"thresholdBinaryOtsuInv/unpipe" [1] forall mv.
-  pipeline (unsafeBinOtsuInv mv) = thresholdBinaryOtsuInv mv
-  #-}
+{-# INLINE thresholdBinaryOtsuInv #-}
 
 -- |Maps pixels that are greater than @threshold@ to the @threshold@
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
 -- and returned along with the thresholded image.
 thresholdTruncateOtsu :: HIplImage MonoChromatic Word8 -> 
-                         (HIplImage MonoChromatic Word8, Word8)
+                         HIplImage MonoChromatic Word8
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
-
-unsafeTruncOtsu :: HIplImage MonoChromatic Word8 -> 
-                   IO (HIplImage MonoChromatic Word8, Word8)
-unsafeTruncOtsu = unsafeCvThresholdOtsu 0 (fromEnum ThreshTrunc)
-
-{-# INLINE [0] thresholdTruncateOtsu #-}
-{-# INLINE [0] unsafeTruncOtsu #-}
-{-# RULES 
-"thresholdTruncateOtsu/in-place" [~1] 
-  thresholdTruncateOtsu = pipeline unsafeTruncOtsu
-"thresholdTruncateOtsu/unpipe" [1]
-  pipeline unsafeTruncOtsu = thresholdTruncateOtsu
-  #-}
+{-# INLINE thresholdTruncateOtsu #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged.The @threshold@ value is chosen
 -- using Otsu's method and returned along with the thresholded image.
 thresholdToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
-                       (HIplImage MonoChromatic Word8, Word8)
+                       HIplImage MonoChromatic Word8
 thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
+{-# INLINE thresholdToZeroOtsu #-}
 
 -- |Maps pixels that are greather than @threshold@ to zero; leaves all
 -- other pixels unchaged.The @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
 thresholdToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
-                          (HIplImage MonoChromatic Word8, Word8)
+                          HIplImage MonoChromatic Word8
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
-
-unsafeToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
-                    IO (HIplImage MonoChromatic Word8, Word8)
-unsafeToZeroOtsu = unsafeCvThresholdOtsu 0 tType
-    where tType = fromEnum ThreshToZero
-
-unsafeToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
-                       IO (HIplImage MonoChromatic Word8, Word8)
-unsafeToZeroOtsuInv = unsafeCvThresholdOtsu 0 tType
-    where tType = fromEnum ThreshToZeroInv
-
-{-# INLINE [0] thresholdToZeroOtsu #-}
-{-# INLINE [0] unsafeToZeroOtsu #-}
-{-# INLINE [0] thresholdToZeroOtsuInv #-}
-{-# INLINE [0] unsafeToZeroOtsuInv #-}
-{-# RULES 
-"thresholdToZeroOtsu/in-place" [~1]
-  thresholdToZeroOtsu = pipeline unsafeToZeroOtsu
-"thresholdToZeroOtsu/unpipe" [1]
-  pipeline unsafeToZeroOtsu = thresholdToZeroOtsu
-"thresholdToZeroOtsuInv/in-place" [~1]
-  thresholdToZeroOtsuInv = pipeline unsafeToZeroOtsuInv
-"thresholdToZeroOtsuInv/unpipe" [1]
-  pipeline unsafeToZeroOtsuInv = thresholdToZeroOtsuInv
-  #-}
+{-# INLINE thresholdToZeroOtsuInv #-}
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
index b999232..d67383a 100644
--- a/src/Examples/CamCanny/CamCanny.hs
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -55,3 +55,9 @@ main = do rater <- trackRate
                 . canny 50 90 3 . convertRGBToGray
           smooth = smoothGaussian 25
           showFPS s = putText (s++" FPS") (300,450) (0,255,0)
+
+-- Unsharp mask.
+main5 = createCameraCapture (Just 0) >>= runWindow . fmap proc
+    where proc x = let d = convertScale 2 0 (absDiff x (smoothGaussian 5 x))
+                       m = thresholdBinary 20 255 (convertRGBToGray d)
+                   in cvSubMask d m x
diff --git a/src/Examples/CamCanny/Makefile b/src/Examples/CamCanny/Makefile
new file mode 100644
index 0000000..ae7d564
--- /dev/null
+++ b/src/Examples/CamCanny/Makefile
@@ -0,0 +1,4 @@
+all:	CamCanny.hs
+	ghc -O3 CamCanny.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
+
+# Show stats on termination: ./CamCanny +RTS -s
\ No newline at end of file

From 68f8981c31bb88e57a4499cb0b8030e30f704132 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 26 May 2011 16:53:14 -0400
Subject: [PATCH 077/137] Extracted the Video module. Fixes to BinOp fusion
 safety. Color conversion fusion. Fixed normalize bug.

---
 HOpenCV.cabal                        |   1 +
 src/AI/CV/OpenCV/ArrayOps.hs         | 185 +++++++++++++++++----------
 src/AI/CV/OpenCV/ColorConversion.hs  |  26 ++--
 src/AI/CV/OpenCV/Core/CV.hsc         |  27 ++--
 src/AI/CV/OpenCV/Core/CVOp.hs        |  68 +---------
 src/AI/CV/OpenCV/Core/CxCore.hsc     |  79 ++++++++----
 src/AI/CV/OpenCV/Core/HIplImage.hsc  |   7 +-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c |   4 +
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h |   2 +
 src/AI/CV/OpenCV/Drawing.hs          |  80 +++++++++++-
 src/AI/CV/OpenCV/FeatureDetection.hs |  14 +-
 src/AI/CV/OpenCV/Filtering.hsc       |   2 +-
 src/AI/CV/OpenCV/FloodFill.hsc       |   2 +-
 src/AI/CV/OpenCV/GUI.hs              |  32 ++++-
 src/AI/CV/OpenCV/HighCV.hs           | 109 +++-------------
 src/AI/CV/OpenCV/Motion.hsc          |   5 +-
 src/AI/CV/OpenCV/Threshold.hs        |   5 +-
 src/AI/CV/OpenCV/Video.hs            |  80 ++++++++++++
 src/Examples/CamCanny/CamCanny.hs    | 158 +++++++++++++++++------
 src/Examples/CamCanny/Rate.hs        |  22 ++++
 20 files changed, 566 insertions(+), 342 deletions(-)
 create mode 100644 src/AI/CV/OpenCV/Video.hs
 create mode 100644 src/Examples/CamCanny/Rate.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 0ec3e60..b3d6fd4 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -36,6 +36,7 @@ library
       AI.CV.OpenCV.Core.ColorConversion
       AI.CV.OpenCV.HighCV
       AI.CV.OpenCV.GUI
+      AI.CV.OpenCV.Video
       AI.CV.OpenCV.FloodFill
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 9f474c6..6c2865b 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,13 +1,14 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables #-}
 -- |Array operations.
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
-                              cvAnd, cvAndMask, cvScaleAdd, cvAndS,
-                              cvMul, cvMul', cvAdd, cvAddS, cvSub,
-                              cvSubMask) where
+                              cvAnd, andMask, scaleAdd, cvAndS,
+                              cvOr, cvOrS, set, setROI, resetROI,
+                              mul, mulS, add, addS, sub,
+                              subMask) where
 import Data.Word (Word8)
-import Foreign.C.Types (CDouble)
+import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage)
+import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..))
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 
@@ -68,14 +69,14 @@ cvAndHelper src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
 -- specifies the elements of the result that will be computed via the
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
-cvAndMask :: (HasChannels c, HasDepth d) => 
-             HIplImage MonoChromatic Word8 -> HIplImage c d ->  
-             HIplImage c d -> HIplImage c d
-cvAndMask mask src1 = cv2 $ \src2 dst -> 
-                      withHIplImage src1 $ \src1' -> 
-                          withHIplImage mask $ \mask' ->
-                              cvAndHelper src1' src2 dst mask'
-{-# INLINE cvAndMask #-}
+andMask :: (HasChannels c, HasDepth d) => 
+           HIplImage MonoChromatic Word8 -> HIplImage c d ->  
+           HIplImage c d -> HIplImage c d
+andMask mask src1 = cv2 $ \src2 dst -> 
+                    withHIplImage src1 $ \src1' -> 
+                        withHIplImage mask $ \mask' ->
+                            cvAndHelper src1' src2 dst mask'
+{-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
@@ -84,7 +85,7 @@ cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' ->
              cvAndHelper src1' src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
-foreign import ccall safe "opencv2/core/core_c.h cvAndS"
+foreign import ccall "opencv2/core/core_c.h cvAndS"
    c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -101,15 +102,17 @@ foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                   Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvScaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
+-- |Calculate the sum of a scaled array and another array. @scaleAdd
+-- src1 s src2@ computes @dst[i] = s*src1[i] + src2[i]@
+scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
                s ~ CvScalar c d, IsCvScalar s) => 
               HIplImage c d -> s -> HIplImage c d -> HIplImage c d
-cvScaleAdd src1 s = cv2 $ \src2 dst ->
-                    withHIplImage src1 $ \src1' ->
-                        c_cvScaleAdd (castPtr src1') r g b a 
-                                     (castPtr src2) (castPtr dst)
+scaleAdd src1 s = cv2 $ \src2 dst ->
+                  withHIplImage src1 $ \src1' ->
+                      c_cvScaleAdd (castPtr src1') r g b a 
+                                   (castPtr src2) (castPtr dst)
     where (r,g,b,a) = toCvScalar s
-{-# INLINE cvScaleAdd #-}
+{-# INLINE scaleAdd #-}
 
 foreign import ccall "opencv2/core/core_c.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
@@ -119,66 +122,116 @@ cvMulHelper src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2)
                                       (castPtr dst) (realToFrac s)
 
 -- |Per-element product of two arrays.
-cvMul :: (HasChannels c, HasDepth d) => 
-         HIplImage c d -> HIplImage c d -> HIplImage c d
-cvMul src1 = cv2 $ \src2 dst -> 
-             withHIplImage src1 $ \src1' ->
-                 cvMulHelper src1' src2 dst 1
-{-# INLINE cvMul #-}
+mul :: (HasChannels c, HasDepth d) => 
+       HIplImage c d -> HIplImage c d -> HIplImage c d
+mul src1 = cv2 $ \src2 dst -> 
+           withHIplImage src1 $ \src1' ->
+               cvMulHelper src1' src2 dst 1
+{-# INLINE mul #-}
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
-cvMul' :: (HasChannels c, HasDepth d) => 
-          Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
-cvMul' scale src1 = cv2 $ \src2 dst ->
-                    withHIplImage src1 $ \src1' ->
-                        cvMulHelper src1' src2 dst scale
-{-# INLINE cvMul' #-}
+mulS :: (HasChannels c, HasDepth d) => 
+        Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
+mulS scale src1 = cv2 $ \src2 dst ->
+                  withHIplImage src1 $ \src1' ->
+                      cvMulHelper src1' src2 dst scale
+{-# INLINE mulS #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
--- |Per-element sum of two arrays.
-cvAdd :: (HasChannels c, HasDepth d) => 
-         HIplImage c d -> HIplImage c d -> HIplImage c d
-cvAdd src1 = cv2 $ \src2 dst ->
-             withHIplImage src1 $ \src1' ->
-                 c_cvAdd (castPtr src1') (castPtr src2) (castPtr dst) nullPtr
-{-# INLINE cvAdd #-}
+-- |Per-element sum.
+add :: (HasChannels c, HasDepth d) => 
+       HIplImage c d -> HIplImage c d -> HIplImage c d
+add src1 = cv2 $ \src2 dst ->
+           withHIplImage src1 $ \src1' ->
+               c_cvAdd (castPtr src1') (castPtr src2) (castPtr dst) nullPtr
+{-# INLINE add #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAddS"
   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
               Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvAddS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-          s -> HIplImage c d -> HIplImage c d
-cvAddS scalar = cv2 $ \src dst -> 
-                c_cvAddS (castPtr src) r g b a (castPtr dst) nullPtr
+-- |Computes the sum of an array and a scalar.
+addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
+        s -> HIplImage c d -> HIplImage c d
+addS scalar = cv2 $ \src dst -> 
+              c_cvAddS (castPtr src) r g b a (castPtr dst) nullPtr
     where (r,g,b,a) = toCvScalar scalar
-{-# INLINE cvAddS #-}
+{-# INLINE addS #-}
 
 foreign import ccall "opencv2/core/core_c.h cvSub"
   c_cvSub :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvSub :: (HasChannels c, HasDepth d) =>
-         HIplImage c d -> HIplImage c d -> HIplImage c d
-cvSub img1 = cv2 $ \img2 dst ->
-             withHIplImage img1 $ \img1' -> 
-                 c_cvSub (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
-{-# INLINE cvSub #-}
-
--- FIXME: This isn't really what one typically wants. If a mask is
--- given, the destination array should be a clone of img1, which makes
--- composition hard.
-
--- |WARNING: Argument order is reversed here! @cvSubMask img2 mask
--- img1@ computes @dest[i] = img1[i] - img2[i] if mask[i]@.
-cvSubMask :: (HasChannels c, HasDepth d) =>
-             HIplImage c d -> HIplImage MonoChromatic Word8 -> HIplImage c d -> 
-             HIplImage c d
-cvSubMask img2 mask = cv $ \img1 ->
-                      withHIplImage mask $ \mask' -> 
-                          withHIplImage img2 $ \img2' ->
-                              c_cvSub (castPtr img1) (castPtr img2') 
-                                      (castPtr img1) (castPtr mask')
-{-# INLINE cvSubMask #-}
\ No newline at end of file
+-- |Per-element difference.
+sub :: (HasChannels c, HasDepth d) =>
+       HIplImage c d -> HIplImage c d -> HIplImage c d
+sub img1 = cv2 $ \img2 dst ->
+           withHIplImage img1 $ \img1' -> 
+               c_cvSub (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
+{-# INLINE sub #-}
+
+-- |WARNING: Argument order may be confusing! @cvSubMask img2 mask
+-- img1@ computes @dst[i] = img1[i] - img2[i] if mask[i]@. The idea is
+-- that @dst@ is the same as @img1@ everywhere @mask@ is zero. This
+-- permits in-place updating of @img1@.
+subMask :: (HasChannels c, HasDepth d) =>
+           HIplImage c d -> HIplImage MonoChromatic Word8 -> HIplImage c d -> 
+           HIplImage c d
+subMask img2 mask = cv $ \img1 ->
+                    withHIplImage mask $ \mask' -> 
+                        withHIplImage img2 $ \img2' ->
+                            c_cvSub (castPtr img1) (castPtr img2') 
+                                    (castPtr img1) (castPtr mask')
+{-# INLINE subMask #-}
+
+foreign import ccall "opencv2/core/core_c.h cvOr"
+  c_cvOr :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Per-element bit-wise disjunction of two arrays
+cvOr :: (HasChannels c, HasDepth d) =>
+        HIplImage c d -> HIplImage c d -> HIplImage c d
+cvOr img1 = cv2 $ \img2 dst ->
+            withHIplImage img1 $ \img1' ->
+                c_cvOr (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
+{-# INLINE cvOr #-}
+
+foreign import ccall "opencv2/core/core_c.h cvOrS"
+  c_cvOrS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+             Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Per-element bit-wise disjunction of an array and a scalar.
+cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
+         s -> HIplImage c d -> HIplImage c d
+cvOrS scalar = cv2 $ \src dst ->
+               c_cvOrS (castPtr src) r g b a (castPtr dst) nullPtr
+    where (r,g,b,a) = toCvScalar scalar
+{-# INLINE cvOrS #-}
+
+foreign import ccall "opencv2/core/core_c.h cvSet"
+  c_cvSet :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+             Ptr CvArr -> IO ()
+
+-- |Per-element bit-wise disjunction of an array and a scalar.
+set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
+       s -> HIplImage c d -> HIplImage c d
+set scalar = cv $ \src ->
+             c_cvSet (castPtr src) r g b a nullPtr
+    where (r,g,b,a) = toCvScalar scalar
+{-# INLINE set #-}
+
+foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
+  c_cvSetImageROI :: Ptr IplImage -> CInt -> CInt -> CInt -> CInt -> IO ()
+
+foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
+  c_cvResetImageROI :: Ptr IplImage -> IO ()
+
+setROI :: (HasChannels c, HasDepth d) => 
+          CvRect -> HIplImage c d -> HIplImage c d
+setROI (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
+{-# INLINE setROI #-}
+
+resetROI :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
+resetROI = cv $ \img -> c_cvResetImageROI img
+{-# INLINE resetROI #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index d6252d6..0ec9d1d 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -7,41 +7,47 @@ module AI.CV.OpenCV.ColorConversion
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
-import System.IO.Unsafe
+import AI.CV.OpenCV.Core.CVOp
 
 convertGrayToRGB :: HasDepth d =>
                     HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToRGB = convertColor cv_GRAY2RGB
+{-# INLINE convertGrayToRGB #-}
 
 convertGrayToBGR :: HasDepth d =>
                     HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertGrayToBGR = convertColor cv_GRAY2BGR
+{-# INLINE convertGrayToBGR #-}
 
 convertBGRToGray :: HasDepth d =>
                     HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertBGRToGray = convertColor cv_BGR2GRAY
+{-# INLINE convertBGRToGray #-}
 
 convertRGBToGray :: HasDepth d =>
                     HIplImage TriChromatic d -> HIplImage MonoChromatic d
 convertRGBToGray = convertBGRToGray
+{-# INLINE convertRGBToGray #-}
 
 convertBayerBgToBGR :: HasDepth d =>
                        HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertBayerBgToBGR = convertColor cv_BayerBG2BGR
+{-# INLINE convertBayerBgToBGR #-}
 
 convertBayerBgToRGB :: HasDepth d =>
                        HIplImage MonoChromatic d -> HIplImage TriChromatic d
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
-
+{-# INLINE convertBayerBgToRGB #-}
 
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
                 ColorConversion -> HIplImage c1 d -> HIplImage c2 d
-convertColor cc img = unsafePerformIO . withHIplImage img $
-                        \src -> do dst <- mkHIplImage w h
-                                   withHIplImage dst $
-                                     \dst' -> cvCvtColor src dst' cc
-                                   return dst
-    where w = width img
-          h = height img
-{-# NOINLINE convertColor #-}
\ No newline at end of file
+convertColor cc = cv2 $ \src dst -> cvCvtColor src dst cc
+-- convertColor cc img = unsafePerformIO . withHIplImage img $
+--                         \src -> do dst <- mkHIplImage w h
+--                                    withHIplImage dst $
+--                                      \dst' -> cvCvtColor src dst' cc
+--                                    return dst
+--     where w = width img
+--           h = height img
+{-# INLINE convertColor #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
index 618c861..5f1943b 100644
--- a/src/AI/CV/OpenCV/Core/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -2,7 +2,7 @@
 -- |Support for features from the OpenCV Image Filtering library.
 module AI.CV.OpenCV.Core.CV 
     ( InterpolationMethod(..),
-      cvCanny, cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
+      cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
       --CvHaarClassifierCascade, HaarDetectFlag,
       --cvHaarFlagNone, cvHaarDoCannyPruning, 
       --cvHaarScaleImage, cvHaarFindBiggestObject, cvHaarDoRoughSearch,
@@ -21,30 +21,19 @@ import AI.CV.OpenCV.Core.ColorConversion
 
 #include <opencv/cv.h>
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCanny"
-  c_cvCanny :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> IO ()
-
--- Canny 
-cvCanny :: (IplArrayType i1, IplArrayType i2) =>
-           Ptr i1 -> Ptr i2 -> Double -> Double -> Int -> IO ()
-cvCanny src dst threshold1 threshold2 apertureSize = 
-  c_cvCanny (fromArr src) (fromArr dst) (realToFrac threshold1) 
-            (realToFrac threshold2) (fromIntegral apertureSize)
-
-
 data InterpolationMethod = CV_INTER_NN 
                          | CV_INTER_LINEAR 
                          | CV_INTER_CUBIC
                          | CV_INTER_AREA
                            deriving (Enum,Eq)
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvResize"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvResize"
   c_cvResize :: Ptr CvArr -> Ptr CvArr -> 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)
 
-foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvDilate"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvDilate"
   c_dilate :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
 -- |Dilate the first image using a 3x3 rectangular structuring element
@@ -53,7 +42,7 @@ foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvDilate"
 cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2  -> CInt -> IO ()
 cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) nullPtr iter
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvErode"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvErode"
   c_erode :: Ptr CvArr -> Ptr CvArr -> Ptr () -> CInt -> IO ()
 
 -- |Erode the first image using a 3x3 rectangular structuring element
@@ -62,7 +51,7 @@ foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvErode"
 cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
 cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvHoughLines2"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvHoughLines2"
         c_cvHoughLines2 :: Ptr CvArr -> Ptr CvMemStorage -> CInt -> CDouble -> CDouble -> CInt -> CDouble -> CDouble -> IO (Ptr (CvSeq a))
 
 cvHoughLines2 :: IplArrayType i => Ptr i -> Ptr CvMemStorage -> CInt -> Double -> Double -> Int -> Double -> Double -> IO (Ptr (CvSeq a))
@@ -71,10 +60,10 @@ cvHoughLines2 img storage method rho theta threshold param1 param2 =
                     (realToFrac theta) (fromIntegral threshold) 
                     (realToFrac param1) (realToFrac param2)
 
-foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvCvtColor"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvCvtColor"
   c_cvCvtColor :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSampleLine"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvSampleLine"
   c_cvSampleLine :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> Ptr a -> 
                     CInt -> IO CInt
 
@@ -107,7 +96,7 @@ cvCvtColor :: (IplArrayType a, IplArrayType b) =>
               Ptr a -> Ptr b -> ColorConversion -> IO ()
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvPyrDown"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvPyrDown"
   c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 -- for now only one filter type is supported so no need for the CInt (filter type)
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index d62d5da..e3f417a 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,3 +1,5 @@
+-- |Combinators that fuse compositions of image processing operations
+-- for in-place mutation.
 module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
 import AI.CV.OpenCV.Core.CxCore (IplImage)
 import AI.CV.OpenCV.Core.HIplUtil
@@ -7,10 +9,6 @@ import Foreign.Ptr
 import Foreign.ForeignPtr
 import System.IO.Unsafe
 
-import Control.Category (Category)
-import qualified Control.Category as Cat
-
-
 -- |A CV operation is an IO function on a 'HIplImage'.
 newtype CVOp c d = CVOp { op :: Ptr IplImage -> IO () }
 
@@ -29,45 +27,11 @@ withClone :: (HasChannels c, HasDepth d) =>
 withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f x >> fromPtr x)
 
 -- |Run a 'CVOp'.
--- runCV :: (HasChannels c, HasDepth d) => CVOp r -> HIplImage c d -> HIplImage c d
--- runCV = ((unsafePerformIO . fmap fst) .) . flip withDuplicateImageIO . runKleisli
 runCV :: (HasChannels c, HasDepth d) => 
          CVOp c d -> HIplImage c d -> HIplImage c d
 runCV = (unsafePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
--- makeUnary f = \img -> do dst <- compatibleImagePtrPtr img
---                          f img dst
---                          return dst
-
-newtype CVOpBi c d = CVOpBi { opbi :: Ptr IplImage -> Ptr IplImage -> IO () }
-
-instance Monoid (CVOpBi c d) where
-    mempty = CVOpBi $ \ _ _ -> return ()
-    CVOpBi f `mappend` CVOpBi g = CVOpBi $ \x y -> g x y >> f y y
-    {-# INLINE mappend #-}
-
-{-
-withComp :: (HasChannels c, HasDepth d) =>
-            (Ptr IplImage -> Ptr IplImage -> IO a) -> 
-            HIplImage c d -> IO (HIplImage c d)
-withComp f img = compatibleImagePtr img >>= 
-                 flip withForeignPtr (\x -> withHIplImage img (flip f x) >> 
-                                            fromPtr x)
--}
-withComp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
-            (Ptr IplImage -> Ptr IplImage -> IO a) -> 
-            HIplImage c1 d1 -> IO (HIplImage c2 d2)
-withComp f img = mkHIplImage (width img) (height img) >>= \img2 -> 
-                 withHIplImage img2 (\x -> withHIplImage img (flip f x) >> 
-                                           return img2)
-
-
-runCVComp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
-             CVOpBi c d -> HIplImage c1 d1 -> HIplImage c2 d2
-runCVComp = (unsafePerformIO .) . withComp . opbi
-{-# NOINLINE runCVComp #-}
-
 -- Apply a binary function to the same argument twice.
 dupArg :: (Ptr IplImage -> Ptr IplImage -> IO ()) -> Ptr IplImage -> IO ()
 dupArg f = \x -> f x x
@@ -77,16 +41,8 @@ dupArg f = \x -> f x x
 cv2 :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
        (Ptr IplImage -> Ptr IplImage -> IO a) -> 
        HIplImage c1 d1 -> HIplImage c2 d2
---cv2 = runCVComp . CVOpBi . ((void .) .)
 cv2 = runBinOp . BinOp . ((void .) .)
 {-# INLINE cv2 #-}
-{-
-bi2unary :: CVOpBi c d -> CVOp c d
-bi2unary = CVOp . dupArg . opbi
-
-unary2bi :: CVOp c d -> CVOpBi c d
-unary2bi = CVOpBi . const . op
--}
 
 bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
 bi2unary = CVOp . dupArg . binop
@@ -101,9 +57,9 @@ unary2bi = BinOp . const . op
 newtype BinOp a b = 
     BinOp { binop :: Ptr IplImage -> Ptr IplImage -> IO () }
 
-instance Category BinOp where
-    id = BinOp . const . const $ return ()
-    BinOp f . BinOp g = BinOp $ \x y -> g x y >> f y y
+-- Compose 'BinOp's for in-place mutation when the types allow it.
+cbop :: BinOp b b -> BinOp a b -> BinOp a b
+cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
 withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
            (Ptr IplImage -> Ptr IplImage -> IO a) ->
@@ -120,20 +76,10 @@ runBinOp = (unsafePerformIO .) . withDst . binop
     forall f g x. runCV f (runCV g x) = runCV (f <> g) x #-}
 
 {-# RULES "runBinOp/fuse"
-    forall f g x. runBinOp f (runBinOp g x) = runBinOp ((Cat..) f g) x #-}
+    forall f g x. runBinOp f (runBinOp g x) = runBinOp (cbop f g) x #-}
 
 {-# RULES "runCV/runBinOp/fuse"
-    forall f g x. runCV f (runBinOp g x) = runBinOp ((Cat..) (unary2bi f) g) x #-}
+    forall f g x. runCV f (runBinOp g x) = runBinOp (cbop (unary2bi f) g) x #-}
 
 {-# RULES "runBinOp/runCV/fuse"
     forall f g x. runBinOp f (runCV g x) = runCV (bi2unary f <> g) x #-}
-
-
-{-# RULES "cvComp/cvComp/fuse"
-    forall f g x. runCVComp f (runCVComp g x) = runCVComp (f <> g) x #-}
-
-{- RULES "runCV/cvComp/apply"
-    forall f g x. runCV f (runCVComp g x) = runCVComp (unary2bi f <> g) x -}
-
-{- RULES "cvComp/runCV/apply"
-    forall f g x. runCVComp f (runCV g x) = runCV (bi2unary f <> g) x -}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 3809a5f..f6e1221 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -150,22 +150,22 @@ numToDepth x = lookup x depthsLookupList
 
 ---------------------------------------------------------------
 -- mem storage
-foreign import ccall unsafe "opencv2/core/core_.h cvCreateMemStorage"
+foreign import ccall "opencv2/core/core_.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 "HOpenCV_wrap.h release_mem_storage"
+-- foreign import ccall "HOpenCV_wrap.h release_mem_storage"
 --   cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvReleaseMemStorage"
+foreign import ccall "opencv2/core/core_c.h cvReleaseMemStorage"
   c_cvReleaseMemStorage :: Ptr (Ptr CvMemStorage) -> IO ()
 
 cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()
 cvReleaseMemStorage mem = alloca $ \p -> poke p mem >> c_cvReleaseMemStorage p
 
-foreign import ccall unsafe "HOpenCV_wrap.h &release_mem_storage"
+foreign import ccall "HOpenCV_wrap.h &release_mem_storage"
   cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ())
 
 createMemStorageF :: CInt -> IO (ForeignPtr CvMemStorage)
@@ -173,7 +173,7 @@ createMemStorageF = (createForeignPtr cp_release_mem_storage) . cvCreateMemStora
 
 -- images / matrices / arrays
 
-foreign import ccall unsafe "HOpenCV_wrap.h create_image"
+foreign import ccall "HOpenCV_wrap.h create_image"
   c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage)
 
 -- |Allocate memory for an 'IplImage' with the given dimensions,
@@ -183,22 +183,22 @@ 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 release_image"
+-- foreign import ccall "HOpenCV_wrap.h release_image"
 --   cvReleaseImage :: Ptr IplImage -> IO ()
-foreign import ccall unsafe "opencv2/core/core_c.h cvReleaseImage"
+foreign import ccall "opencv2/core/core_c.h cvReleaseImage"
   c_cvReleaseImage :: Ptr (Ptr IplImage) -> IO ()
 
 -- |Release the memory allocated to an 'IplImage'.
 cvReleaseImage :: Ptr IplImage -> IO ()
 cvReleaseImage mem = alloca $ \p -> poke p mem >> c_cvReleaseImage p
 
-foreign import ccall unsafe "HOpenCV_wrap.h &release_image"
+foreign import ccall "HOpenCV_wrap.h &release_image"
   cp_release_image :: FunPtr (Ptr IplImage -> IO ())
 
 createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage)
 createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvCloneImage"
+foreign import ccall "opencv2/core/core_c.h cvCloneImage"
   c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
 
 cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
@@ -207,10 +207,10 @@ cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage
 cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage)
 cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x
   
-foreign import ccall unsafe "HOpenCV_wrap.h get_size"
+foreign import ccall "HOpenCV_wrap.h get_size"
   c_get_size :: Ptr CvArr -> Ptr CvSize -> IO ()
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvCopy"
+foreign import ccall "opencv2/core/core_c.h cvCopy"
   c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
                    
 -- todo add mask support
@@ -223,7 +223,7 @@ cvGetSize p = alloca $ \cvSizePtr -> do
                 size <- peek cvSizePtr
                 return size
 
-foreign import ccall unsafe "HOpenCV_wrap.h get_depth"
+foreign import ccall "HOpenCV_wrap.h get_depth"
   c_get_depth :: Ptr IplImage -> IO CInt
 
 getDepth :: Ptr IplImage -> IO Depth
@@ -233,23 +233,23 @@ getDepth img = do
     Nothing -> fail "Bad depth in image struct"
     Just depth -> return depth
 
-foreign import ccall unsafe "HOpenCV_wrap.h get_nChannels"
+foreign import ccall "HOpenCV_wrap.h get_nChannels"
   c_get_nChannels :: Ptr IplImage -> IO CInt
 
 getNumChannels :: Integral a => Ptr IplImage -> IO a
 getNumChannels img = fmap fromIntegral $ c_get_nChannels img
 
 
-foreign import ccall unsafe "opencv/cxcore.h cvConvertScale"
+foreign import ccall "opencv/cxcore.h cvConvertScale"
   cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
                                 
-foreign import ccall unsafe "HOpenCV_wrap.h cv_free"
+foreign import ccall "HOpenCV_wrap.h cv_free"
   cvFree :: Ptr a -> IO ()
 
-foreign import ccall unsafe "HOpenCV_wrap.h &cv_free"
+foreign import ccall "HOpenCV_wrap.h &cv_free"
   cvFreePtr :: FunPtr (Ptr a -> IO ())
 
-foreign import ccall unsafe "opencv2/core/core_c.h cvLoad"
+foreign import ccall "opencv2/core/core_c.h cvLoad"
   c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a)
 
 cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String)
@@ -267,13 +267,13 @@ cvLoad filename memstorage name = withCString filename cvLoad'
               cvFree realNameC
               return (ptrObj, realName)
               
-foreign import ccall unsafe "opencv2/core/core_c.h cvGetSeqElem"
+foreign import ccall "opencv2/core/core_c.h cvGetSeqElem"
   cvGetSeqElem :: Ptr (CvSeq a) -> CInt -> IO (Ptr a)
   
--- foreign import ccall unsafe "HOpenCV_wrap.h c_rect_cvGetSeqElem"
+-- foreign import ccall "HOpenCV_wrap.h c_rect_cvGetSeqElem"
 --   cvGetSeqElemRect :: Ptr (CvSeq (Ptr CvRect)) -> CInt -> IO (Ptr CvRect)
 
-foreign import ccall unsafe "HOpenCV_wrap.h seq_total"
+foreign import ccall "HOpenCV_wrap.h seq_total"
   seqNumElems :: Ptr (CvSeq a) -> IO CInt
 
 seqToPList :: Ptr (CvSeq a) -> IO [Ptr a]
@@ -297,13 +297,13 @@ seqToList pseq = do
 --     rect <- peek rectP
 --     return rect
 
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvRectangle"
+foreign import ccall "HOpenCV_wrap.h c_cvRectangle"
   c_cvRectangle :: Ptr CvArr -> 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
 
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvLine"
+foreign import ccall "HOpenCV_wrap.h c_cvLine"
         c_cvLine :: Ptr CvArr -> CInt -> CInt  -> CInt -> CInt -> 
                     CDouble -> CDouble -> CDouble -> CInt -> 
                     CInt -> CInt -> IO ()
@@ -317,9 +317,36 @@ cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
         where fi = fromIntegral
               fr = realToFrac
 
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvPutText"
-  c_cvPutText :: Ptr CvArr -> CString -> CInt -> CInt -> 
-                 CDouble -> CDouble -> CDouble -> IO ()
+data CvFont
+instance Storable CvFont where
+  sizeOf _ = (#size CvFont)
+  alignment _ = alignment (undefined::CDouble)
+
+italicFont :: CInt
+italicFont = (#const CV_FONT_ITALIC)
+
+foreign import ccall "opencv2/core/core_c.h cvInitFont"
+  cvInitFont :: Ptr CvFont -> CInt -> CDouble -> CDouble -> CDouble -> 
+                CInt -> CInt -> IO ()
+
+foreign import ccall "opencv2/core/core_c.h cvPutText"
+  cvPutText :: Ptr CvArr -> CString -> CInt -> CInt -> Ptr CvFont -> 
+               CDouble -> CDouble -> CDouble -> IO ()
+
+newtype ArrayNorm = ArrayNorm { unNorm :: CInt } 
+    deriving (Eq, Show)
+#{enum ArrayNorm, ArrayNorm
+  , cv_C = CV_C
+  , cv_L1 = CV_L1
+  , cv_L2 = CV_L2
+  , cv_NormMask = CV_NORM_MASK
+  , cv_Relative = CV_RELATIVE
+  , cv_Diff = CV_DIFF
+  , cv_MinMax = CV_MINMAX }
+
+foreign import ccall "opencv2/core/core_c.h cvNormalize"
+  cvNormalize :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
+                 Ptr CvArr -> IO ()
 
 -- |Convert null pointers to 'Nothing' and non-null pointers to 'Just'
 -- values.
@@ -330,5 +357,5 @@ ptrToMaybe p = if p == nullPtr then Nothing else Just p
 -- Debugging stuff, not part of opencv
 
 -- | Debugging function to print some of the internal details of an IplImage structure
-foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header"
+foreign import ccall "HOpenCV_wrap.h debug_print_image_header"
   c_debug_print_image_header :: Ptr IplImage -> IO ()
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 75bac29..dbbbf69 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
-             BangPatterns #-}
+             BangPatterns, FlexibleContexts #-}
 module AI.CV.OpenCV.Core.HIplImage 
     ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
@@ -84,6 +84,11 @@ class HasDepth a => ByteOrFloat a where
 instance ByteOrFloat Word8 where
 instance ByteOrFloat Float where
 
+-- FIXME: Perhaps it would be better to use a distinct type for the
+-- scalar type of color images? I'm having some trouble getting this
+-- type to fit in, though.
+--data RGB d = RGB !d !d !d
+
 -- |An image with a particular number of channels have an associated
 -- scalar type built from the type of its pixels. This class lets us
 -- ensure that a scalar value to be used in an operation with an image
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index dbf906d..52425ea 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -171,6 +171,10 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
                           method, cvPoint(offset_x,offset_y));
 }
 
+void c_cvSetRoi(IplImage* img, int x, int y, int width, int height)
+{
+  cvSetImageROI(img, cvRect(x,y,width,height));
+}
 
 
 /****************************************************************************/
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 3f9d181..6d13834 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -31,6 +31,8 @@ void c_cvRectangle(CvArr *img, int x, int y, int width, int height);
 void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
               double b, int thickness, int lineType, int shift);
 
+void c_cvSetRoi(IplImage* img, int x, int y, int width, int height);
+
 void c_cvPutText(CvArr *img, const char* msg, int x, int y, 
                  double r, double g, double b);
 
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
index 9ec3de4..a669201 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -1,19 +1,85 @@
-module AI.CV.OpenCV.Drawing where
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
+module AI.CV.OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
+                             LineType(..), RGB, drawLines) where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
+import Data.Bits ((.|.))
 import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Marshal.Alloc (malloc)
 import Foreign.Ptr
+import System.IO.Unsafe (unsafePerformIO)
+
+-- |The available font faces are a subset of the Hershey fonts.
+data FontFace = NormalSans 
+              | SmallSans 
+              | ComplexSans 
+              | NormalSerif
+              | ComplexSerif
+              | SmallSerif
+              | Script 
+              | ComplexScript
+                deriving Enum
+
+initFont :: FontFace -> Bool -> CDouble -> CDouble -> CDouble -> CInt -> 
+            LineType -> IO (Ptr CvFont)
+initFont face italic hscale vscale shear thickness ltype = 
+    do p <- malloc
+       cvInitFont p face' hscale vscale shear thickness lt
+       return p
+    where face' | italic = (fi $ fromEnum face) .|. italicFont
+                | otherwise = fi $ fromEnum face
+          lt = fi $ lineTypeEnum ltype
+          fi = fromIntegral
+
+-- |Default sans-serif font.
+defaultFont :: Ptr CvFont
+defaultFont = unsafePerformIO $ initFont NormalSans False 1 1 0 1 EightConn
+
+-- |Produce a text-drawing function given a font description. The
+-- application @prepFont face italic hscale vscale thickness@ produces
+-- a text-drawing function using a font with the given @face@ (which
+-- may be @italic@), horizontal and verticale scale, and line
+-- @thickness@.
+prepFont :: (HasChannels c, HasDepth d) =>
+            FontFace -> Bool -> CDouble -> CDouble -> CInt -> 
+            IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
+                HIplImage c d -> HIplImage c d)
+prepFont face italic hscale vscale thickness = 
+    prepFontAlt face italic hscale vscale 0 thickness EightConn
+{-# INLINE prepFont #-}
+
+-- |Produce a text-drawing function given a font description. The
+-- application @prepFontAlt face italic hscale vscale shear thickness
+-- ltype@ produces a text-drawing function using a font with the given
+-- @face@ (which may be @italic@), horizontal and vertical scale,
+-- @shear@, line @thickness@, and line type.
+prepFontAlt :: (HasChannels c, HasDepth d) =>
+               FontFace -> Bool -> CDouble -> CDouble -> CDouble -> 
+               CInt -> LineType ->
+               IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
+                   HIplImage c d -> HIplImage c d)
+prepFontAlt face italic hscale vscale shear thickness ltype =     
+    do f <- initFont face italic hscale vscale shear thickness ltype
+       let go (x,y) (r,g,b) msg = cv $ \dst -> 
+                                  withCString msg $ \msg' ->
+                                      cvPutText (castPtr dst) msg' x y f r g b
+           {-# INLINE go #-}
+       return $ go
+{-# INLINE prepFontAlt #-}
 
 putText :: (HasChannels c, HasDepth d) => 
-           String -> (Int,Int) -> (Double,Double,Double) -> 
+           (CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
            HIplImage c d -> HIplImage c d
-putText msg (x,y) (r,g,b) = cv $ \dst ->
+putText (x,y) (r,g,b) msg = cv $ \dst ->
                             withCString msg $ \msg' ->
-                                c_cvPutText (castPtr dst) msg' (fi x) (fi y) 
-                                            (fr r) (fr g) (fr b)
-    where fi = fromIntegral
-          fr = realToFrac
+                                cvPutText (castPtr dst) msg' x y defaultFont
+                                          r g b
+                                -- c_cvPutText (castPtr dst) msg' (fi x) (fi y) 
+                                --             (fr r) (fr g) (fr b)
+    -- where fi = fromIntegral
+    --       fr = realToFrac
 {-# INLINE putText #-}
 
 -- |Type of line to draw.
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index f173177..5e43cb9 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -7,7 +7,7 @@ import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvCornerHarris"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
 
 harris :: Ptr IplImage -> Ptr IplImage -> Int -> Int -> Double -> IO ()
@@ -16,13 +16,8 @@ harris src dst blockSize aperture k =
     where fi = fromIntegral
           rf = realToFrac
 
--- |Harris corner detector. For each pixel, a 2x2 covariance matrix,
--- @M@, is computed over a @blockSize x blockSize@ neighborhood. The
--- value of @det(M) - 0.04*trace(M)^2@ is stored in the destination
--- image. Corners in the image correspond to local maxima of the
--- destination image. The parameters are the @blockSize@ and the
--- source 'HIplImage'. The Sobel operator used as a preprocessing step
--- is given an aperture size of 3.
+-- |Equivalent to 'cornerHarris'' with an @aperture@ of @3@ and a @k@
+-- of @0.04@.
 cornerHarris :: ByteOrFloat d => 
                 Int -> HIplImage MonoChromatic d -> 
                 HIplImage MonoChromatic Float
@@ -44,7 +39,7 @@ cornerHarris' blockSize aperture k =
     cv2 $ \src dst -> harris src dst blockSize aperture k
 {-# INLINE cornerHarris' #-}
 
-foreign import ccall safe "opencv2/imgprog/imgproc_c.h cvCanny"
+foreign import ccall "opencv2/imgprog/imgproc_c.h cvCanny"
   c_cvCanny :: Ptr IplImage -> Ptr IplImage -> CDouble -> CDouble -> CInt -> IO ()
 
 -- |Canny edge detector. @canny threshold1 threshold2 aperture src@
@@ -59,4 +54,3 @@ canny t1 t2 aperture =
     cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
   where rf = realToFrac
         fi = fromIntegral
-    
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index b8197b8..056d2de 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -9,7 +9,7 @@ import AI.CV.OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
 
-foreign import ccall safe "opencv2/imgproc/imgproc_c.h cvSmooth"
+foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSmooth"
   c_cvSmooth :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> CDouble -> 
                 CDouble -> IO ()
 
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index e9f41b2..11f44bd 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -17,7 +17,7 @@ data FloodRange = FloodFixed | FloodFloating
 
 #include <opencv2/imgproc/imgproc_c.h>
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvFloodFill"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvFloodFill"
   c_cvFloodFill :: Ptr CvArr -> CInt -> CInt -> 
                    CDouble -> CDouble -> CDouble -> CDouble ->
                    CDouble -> CDouble -> CDouble -> CDouble ->
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index 12b0729..698cdd5 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -1,19 +1,43 @@
+-- |Very simple tools for showing images in a window. The 'runWindow'
+-- and 'runNamedWindow' interfaces are the recommended entrypoints.
 module AI.CV.OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
-                         waitKey, cvInit) where
+                         waitKey, cvInit, runWindow, runNamedWindow) where
 import AI.CV.OpenCV.Core.HIplImage
 import AI.CV.OpenCV.Core.HighGui
 import AI.CV.OpenCV.Core.CxCore (fromArr)
 import Control.Monad ((>=>))
+import Data.Word (Word8)
+import Foreign.Ptr (castPtr)
 import Foreign.C.String (newCString)
 
---type KeyboardCallback = Int -> IO ()
+bool :: a -> a -> Bool -> a
+bool t _ True = t
+bool _ f False = f
+
+-- |Simple window runner. Exits when any key is pressed.
+runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
+runWindow mkImg = newWindow 0 True >> go
+    where go = do mkImg >>= flip withHIplImage (showImage 0)
+                  cvWaitKey 1 >>= bool (delWindow 0) go . (> 0)
+
+-- |Simple named window runner. Exits when any key is pressed. The
+-- name is shown in the window's title bar.
+runNamedWindow :: HasChannels c => String -> IO (HIplImage c Word8) -> IO ()
+runNamedWindow name mkImg = 
+    do name' <- newCString name
+       cvNamedWindow name' (windowFlagsToEnum [AutoSize])
+       let showImg = cvShowImage name' . castPtr
+           go = do mkImg >>= flip withHIplImage showImg
+                   cvWaitKey 1 >>= bool (cvDestroyWindow name') go . (> 0)
+       go
 
 -- |Create a new window with the given title. The return value is an
--- action for destroying the window.
+-- action for showing an image, and an action for destroying the
+-- window. Be sure to repeatedly invoke 'waitKey' to keep the system
+-- alive.
 namedWindow :: (HasChannels c, HasDepth d) => 
                String -> [WindowFlag] -> 
                Maybe MouseCallback -> 
-               --Maybe KeyboardCallback ->
                IO (HIplImage c d -> IO (), IO ())
 namedWindow name flags _cb =
   do cstr <- newCString name
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 4c6b5ba..8f52785 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -6,39 +6,37 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             HIplImage, width, height, isColor, isMono,
                             pixels, withPixels, fromGrayPixels, fromColorPixels,
                             fromFile, fromFileGray, fromFileColor, 
-                            fromPGM16, toFile, fromPtr, 
+                            fromPGM16, toFile, fromPtr, normalize,
                             withImagePixels, sampleLine, Connectivity(..), 
-                            fromPixels, createFileCapture, 
-                            createCameraCapture, resize, FourCC, getROI,
+                            fromPixels, resize, getROI, CvRect(..),
+                            cv_L2, cv_MinMax,
                             InterpolationMethod(..), MonoChromatic, 
-                            TriChromatic, createVideoWriter, HasChannels,
-                            module AI.CV.OpenCV.ColorConversion, GrayImage,
-                            ColorImage, GrayImage16, createFileCaptureLoop, 
-                            HasDepth, module AI.CV.OpenCV.Threshold,
+                            TriChromatic, HasChannels, HasDepth,
+                            GrayImage, ColorImage, GrayImage16, 
+                            module AI.CV.OpenCV.ColorConversion,
+                            module AI.CV.OpenCV.Threshold,
                             module AI.CV.OpenCV.FloodFill,
                             module AI.CV.OpenCV.FeatureDetection,
-                            runWindow, module AI.CV.OpenCV.Drawing)
+                            module AI.CV.OpenCV.Drawing,
+                            module AI.CV.OpenCV.GUI,
+                            module AI.CV.OpenCV.Video)
     where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
-import AI.CV.OpenCV.Core.HighGui (createFileCaptureF, cvQueryFrame, cvInit,
-                                  setCapturePos, CapturePos(PosFrames), 
-                                  CvCapture, createCameraCaptureF, 
-                                  createVideoWriterF, cvWriteFrame, FourCC,
-                                  newWindow, delWindow, showImage, cvWaitKey)
 import AI.CV.OpenCV.Drawing
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 import AI.CV.OpenCV.ColorConversion
---import AI.CV.OpenCV.Contours
 import Data.Word (Word8, Word16)
+import Foreign.C.Types (CDouble)
 import Foreign.Ptr
-import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.GUI
 import AI.CV.OpenCV.Threshold
 import AI.CV.OpenCV.FloodFill
 import AI.CV.OpenCV.FeatureDetection
+import AI.CV.OpenCV.Video
 
 -- |Grayscale 8-bit (per-pixel) image type.
 type GrayImage = HIplImage MonoChromatic Word8
@@ -136,72 +134,6 @@ findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
 -}
 
--- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
--- returns a 'Ptr' 'IplImage'.
-queryError :: Ptr CvCapture -> IO (Ptr IplImage)
-queryError = (maybe (error "Unable to capture frame") id `fmap`) . cvQueryFrame
-
--- |If 'cvQueryFrame' returns 'Nothing', try rewinding the video and
--- querying again. If it still fails, raise an error. When a non-null
--- frame is obtained, return it.
-queryFrameLoop :: Ptr CvCapture -> IO (Ptr IplImage)
-queryFrameLoop cap = do f <- cvQueryFrame cap
-                        case f of
-                          Nothing -> do setCapturePos cap (PosFrames 0)
-                                        queryError cap
-                          Just f' -> return f'
-
--- |Open a capture stream from a movie file. The returned action may
--- be used to query for the next available frame. If no frame is
--- available either due to error or the end of the video sequence,
--- 'Nothing' is returned.
-createFileCapture :: (HasChannels c, HasDepth d) => 
-                     FilePath -> IO (IO (Maybe (HIplImage c d)))
-createFileCapture fname = do capture <- createFileCaptureF fname
-                             return (withForeignPtr capture $ \cap ->
-                                       do f <- cvQueryFrame cap
-                                          case f of
-                                            Nothing -> return Nothing
-                                            Just f' -> Just `fmap` fromPtr f')
-
--- |Open a capture stream from a movie file. The returned action may
--- be used to query for the next available frame. The sequence of
--- frames will return to its beginning when the end of the video is
--- encountered.
-createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
-                         FilePath -> IO (IO (HIplImage c d))
-createFileCaptureLoop fname = do capture <- createFileCaptureF fname
-                                 return (withForeignPtr capture $ 
-                                         (>>= fromPtr) . queryFrameLoop)
-
-
--- |Open a capture stream from a connected camera. The parameter is
--- the index of the camera to be used, or 'Nothing' if it does not
--- matter what camera is used. The returned action may be used to
--- query for the next available frame.
-createCameraCapture :: (HasChannels c, HasDepth d) =>
-                       Maybe Int -> IO (IO (HIplImage c d))
-createCameraCapture cam = do cvInit
-                             capture <- createCameraCaptureF cam'
-                             return (withForeignPtr capture $ 
-                                     (>>= fromPtr) . queryError)
-    where cam' = maybe (-1) id cam
-
--- |Create a video file writer. The parameters are the file name, the
--- 4-character code (of the codec used to compress the frames
--- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
--- created video stream, and the size of the video frames. The
--- returned action may be used to add frames to the video stream.
-createVideoWriter :: (HasChannels c, HasDepth d) =>
-                     FilePath -> FourCC -> Double -> (Int,Int) -> 
-                     IO (HIplImage c d -> IO ())
-createVideoWriter fname codec fps sz = 
-    do writer <- createVideoWriterF fname codec fps sz
-       let writeFrame img = withForeignPtr writer $ \writer' ->
-                              withHIplImage img $ \img' ->
-                                cvWriteFrame writer' img'
-       return writeFrame
-
 -- FIXME: There is no fusion mechanism that can handle 'resize'. The
 -- problem is that the fusion combinators assume the output image is
 -- the same size as the input image as this information is not
@@ -221,11 +153,10 @@ resize method w h img =
        return img'
 {-# NOINLINE resize #-}
 
---runWindow :: (HasChannels c, HasDepth d) => IO (HIplImage c d) -> IO ()
-runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
-runWindow mkImg = go
-    where go = do newWindow 0 True
-                  mkImg >>= flip withHIplImage (showImage 0)
-                  cvWaitKey 1 >>= bool (delWindow 0) go . (> 0)
-          bool t _ True = t
-          bool _ f False = f
\ No newline at end of file
+normalize :: (HasChannels c, HasDepth d) => 
+             ArrayNorm -> CDouble -> CDouble -> HIplImage c d -> HIplImage c d
+normalize ntype a b = cv2 $ \img dst -> 
+                      cvNormalize (castPtr img) (castPtr dst) a b (unNorm ntype) 
+                                  nullPtr
+{-# INLINE normalize #-}
+             
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index 5a6489c..44c05b5 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
--- |Motion analysis functions. Possibly BROKEN in OpenCV 2.2.
+-- |Motion analysis functions.
 module AI.CV.OpenCV.Motion (calcOpticalFlowBM) where
 import Data.Word (Word8)
 import Foreign.C.Types (CInt)
@@ -8,8 +8,6 @@ import System.IO.Unsafe
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplImage
 
--- FIXME: This is missing from the C API of OpenCV 2.2
---foreign import ccall unsafe "opencv/cv.h cvCalcOpticalFlowBM"
 foreign import ccall unsafe "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
   c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
                            CInt -> CInt -> CInt -> CInt -> 
@@ -44,3 +42,4 @@ calcOpticalFlowBM prev curr blockSize shiftSize maxRange =
           h = (height prev - snd blockSize) `div` snd shiftSize
           sw = fromIntegral . fst -- size width
           sh = fromIntegral . snd -- size height
+{-# NOINLINE calcOpticalFlowBM #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index e29f429..b16d9dc 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, 
              MultiParamTypeClasses, FlexibleInstances #-}
 -- |Image thresholding operations. These operations will perform
--- destructive, in-place updates when composed with a producer of
--- fresh images.
+-- destructive, in-place updates when used in compositions.
 module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdTruncate, 
                                thresholdToZero, thresholdToZeroInv,
@@ -33,7 +32,7 @@ class (HasDepth d1, HasDepth d2) => SameOrByte d1 d2 where
 instance SameOrByte Float Word8 where
 instance ByteOrFloat d => SameOrByte d d where
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvThreshold"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                    IO (CDouble)
 
diff --git a/src/AI/CV/OpenCV/Video.hs b/src/AI/CV/OpenCV/Video.hs
new file mode 100644
index 0000000..4933cf5
--- /dev/null
+++ b/src/AI/CV/OpenCV/Video.hs
@@ -0,0 +1,80 @@
+-- |Interfaces for grabbing images from cameras and video files, and
+-- for writing to video files.
+module AI.CV.OpenCV.Video (createFileCapture, createFileCaptureLoop, 
+                           createCameraCapture, createVideoWriter, 
+                           FourCC, mpeg4CC) where
+import Foreign.Ptr
+import Foreign.ForeignPtr (withForeignPtr)
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.HighGui
+
+-- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
+-- returns a 'Ptr' 'IplImage'.
+queryError :: Ptr CvCapture -> IO (Ptr IplImage)
+queryError = (maybe (error "Unable to capture frame") id `fmap`) . cvQueryFrame
+
+-- |If 'cvQueryFrame' returns 'Nothing', try rewinding the video and
+-- querying again. If it still fails, raise an error. When a non-null
+-- frame is obtained, return it.
+queryFrameLoop :: Ptr CvCapture -> IO (Ptr IplImage)
+queryFrameLoop cap = do f <- cvQueryFrame cap
+                        case f of
+                          Nothing -> do setCapturePos cap (PosFrames 0)
+                                        queryError cap
+                          Just f' -> return f'
+
+-- |Open a capture stream from a movie file. The returned action may
+-- be used to query for the next available frame. If no frame is
+-- available either due to error or the end of the video sequence,
+-- 'Nothing' is returned.
+createFileCapture :: (HasChannels c, HasDepth d) => 
+                     FilePath -> IO (IO (Maybe (HIplImage c d)))
+createFileCapture fname = do capture <- createFileCaptureF fname
+                             return (withForeignPtr capture $ \cap ->
+                                       do f <- cvQueryFrame cap
+                                          case f of
+                                            Nothing -> return Nothing
+                                            Just f' -> Just `fmap` fromPtr f')
+
+-- |Open a capture stream from a movie file. The returned action may
+-- be used to query for the next available frame. The sequence of
+-- frames will return to its beginning when the end of the video is
+-- encountered.
+createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
+                         FilePath -> IO (IO (HIplImage c d))
+createFileCaptureLoop fname = do capture <- createFileCaptureF fname
+                                 return (withForeignPtr capture $ 
+                                         (>>= fromPtr) . queryFrameLoop)
+
+
+-- |Open a capture stream from a connected camera. The parameter is
+-- the index of the camera to be used, or 'Nothing' if it does not
+-- matter what camera is used. The returned action may be used to
+-- query for the next available frame.
+createCameraCapture :: (HasChannels c, HasDepth d) =>
+                       Maybe Int -> IO (IO (HIplImage c d))
+createCameraCapture cam = do cvInit
+                             capture <- createCameraCaptureF cam'
+                             return (withForeignPtr capture $ 
+                                     (>>= fromPtr) . queryError)
+    where cam' = maybe (-1) id cam
+
+-- |4-character code for MPEG-4.
+mpeg4CC :: FourCC
+mpeg4CC = ('F','M','P','4')
+
+-- |Create a video file writer. The parameters are the file name, the
+-- 4-character code (of the codec used to compress the frames
+-- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
+-- created video stream, and the size of the video frames. The
+-- returned action may be used to add frames to the video stream.
+createVideoWriter :: (HasChannels c, HasDepth d) =>
+                     FilePath -> FourCC -> Double -> (Int,Int) -> 
+                     IO (HIplImage c d -> IO ())
+createVideoWriter fname codec fps sz = 
+    do writer <- createVideoWriterF fname codec fps sz
+       let writeFrame img = withForeignPtr writer $ \writer' ->
+                              withHIplImage img $ \img' ->
+                                cvWriteFrame writer' img'
+       return writeFrame
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
index d67383a..813b0a2 100644
--- a/src/Examples/CamCanny/CamCanny.hs
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -3,61 +3,137 @@ import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
 import Control.Applicative
 import Control.Parallel
-import Data.IORef
-import Text.Printf
-import Data.Time.Clock
+import Rate (trackRate)
 
 -- Just real-time edges
 main2 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc = canny 50 90 3 . convertRGBToGray
+    where proc = canny 70 110 3 . convertRGBToGray
+
+-- Edges saved to file
+main2a = do write <- createVideoWriter "hcv-edges.mp4" mpeg4CC 15 (640,480)
+            cam <- createCameraCapture (Just 0)
+            runWindow $ proc <$> cam >>= 
+                        (>>) <$> write . convertGrayToBGR <*> return
+    where proc = canny 70 110 3 . convertRGBToGray
 
 -- Thick red edges added to raw video
-main1 = createCameraCapture (Just 0) >>= runWindow . fmap (cvAdd <$> id <*> proc)
+main1 = createCameraCapture (Just 0) >>= runWindow . fmap (add <$> id <*> proc)
     where proc = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
                . canny 50 90 3 . convertRGBToGray
 
-trackRate :: IO (IO String)
-trackRate = do numFrames <- newIORef 0
-               oldRate <- newIORef ""
-               startTime <- getCurrentTime >>= newIORef
-               return $ do n <- readIORef numFrames
-                           if n == 30 then
-                             do t <- getCurrentTime
-                                s <- readIORef startTime
-                                let dt = realToFrac $ diffUTCTime t s :: Float
-                                    msg = printf "%.2f" (30.0 / dt)
-                                writeIORef startTime t
-                                writeIORef numFrames 0
-                                writeIORef oldRate msg
-                                return msg
-                           else
-                             do writeIORef numFrames (n+1)
-                                readIORef oldRate
 
 -- Thick red edges added to smoothed video (parallelism!).
 main3 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc x = let e = edges x 
-                       s = smooth x
-                   in e `par` s `pseq` cvAdd e s
+    where proc x = let e = edges x; s = smooth x
+                   in e `par` s `pseq` add e s
           edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
                 . canny 50 90 3 . convertRGBToGray
-          smooth = smoothGaussian 25
+          smooth = smoothGaussian 21
+
+-- A very low-quality unsharp mask.
+main5 = createCameraCapture (Just 0) >>= runWindow . fmap proc
+    where proc x = let g = convertRGBToGray x :: GrayImage
+                   in halvsies (convertGrayToRGB . normalize cv_MinMax 200 50 $ g)
+                               (convertGrayToRGB g) 
+    --where proc x = halvsies (sub x . sub x . smoothGaussian 5 $ x) x
+    -- where proc x = let d = convertScale 5 0 (absDiff x (smoothGaussian 5 x))
+    --                    m = thresholdBinary 50 255 (convertRGBToGray d)
+    --               in halvsies (subMask d m x) x
+
+halvsies :: ColorImage -> ColorImage -> ColorImage
+halvsies l r = cvOr l' r'
+    where l' = resetROI . set (0,0,0) . setROI (CvRect 320 0 320 480) $ l
+          r' = resetROI . set (0,0,0) . setROI (CvRect 0 0 320 480) $ r
 
 -- Thick red edges added to smoothed video with framerate display.
-main = do rater <- trackRate
-          cam <- createCameraCapture (Just 0)
-          runWindow $ do msg <- rater
-                         proc msg <$> cam
-    where proc msg x = let e = edges x 
-                           s = smooth x
-                       in e `par` s `pseq` showFPS msg (cvAdd e s)
+main6 = do rater <- trackRate
+           cam <- createCameraCapture (Just 0)
+           runWindow $ proc <$> rater <*> cam
+    where proc msg x = let e = edges x; s = smooth x
+                       in e `par` s `pseq` showFPS msg (add e s)
           edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 50 90 3 . convertRGBToGray
-          smooth = smoothGaussian 25
-          showFPS s = putText (s++" FPS") (300,450) (0,255,0)
+                . canny 70 110 3 . convertRGBToGray
+          smooth = smoothGaussian 21
+          showFPS = putText (300,450) (0,255,0) . (++" FPS")
 
--- Unsharp mask.
-main5 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc x = let d = convertScale 2 0 (absDiff x (smoothGaussian 5 x))
-                       m = thresholdBinary 20 255 (convertRGBToGray d)
-                   in cvSubMask d m x
+-- Thick red edges added to smoothed video with framerate displayed in
+-- a customized font.
+main7 = do rater <- trackRate
+           cam <- createCameraCapture (Just 0)
+           str <- prepFont ComplexSerif False 1 1 2
+           let str' = str (300,450) (0,255,0) . (++ " FPS")
+           runWindow $ proc . str' <$> rater <*> cam
+    where proc msg x = let e = edges x; s = smooth x
+                       in e `par` s `pseq` msg (add e s)
+          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
+                . canny 70 110 3 . convertRGBToGray
+          smooth = smoothGaussian 21
+
+-- Thick red edges added to smoothed video with framerate displayed in
+-- a customized font saved to a video file.
+main8 = do rater <- trackRate
+           cam <- createCameraCapture (Just 0)
+           str <- prepFont ComplexSerif False 1 1 2
+           let str' = str (300,450) (0,255,0) . (++ " FPS")
+           write <- createVideoWriter "hcv.mp4" mpeg4CC 15 (640,480)
+           runWindow $ do msg <- str' <$> rater
+                          img <- proc msg <$> cam
+                          (write *> return) img
+    where proc msg x = let e = edges x; s = smooth x
+                       in e `par` s `pseq` msg (add e s)
+          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
+                . canny 70 110 3 . convertRGBToGray
+          smooth = smoothGaussian 21
+
+-- Thick red edges added to smoothed video with framerate displayed in
+-- a customized font saved to a video file. Terse code.
+main9 = do rater <- trackRate
+           cam <- createCameraCapture (Just 0)
+           str <- prepFont ComplexSerif False 1 1 2
+           let str' = str (300,450) (0,255,0) . (++ " FPS")
+           write <- createVideoWriter "hcv.mp4" mpeg4CC 15 (640,480)
+           runWindow $ (proc . str' <$> rater) <*> cam >>= 
+                       ((>>) <$> write <*> return)
+    where proc msg x = let e = edges x; s = smooth x
+                       in e `par` s `pseq` msg (add e s)
+          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
+                . canny 70 110 3 . convertRGBToGray
+          smooth = smoothGaussian 21
+
+-- Two-tone blueprint video.
+main10 = do rater <- trackRate
+            cam <- createCameraCapture (Just 0)
+            str <- prepFont ComplexSerif False 1 1 2
+            let str' = str (300,450) (0,255,0) . (++ " FPS")
+            runWindow $ proc . str' <$> rater <*> cam
+    where proc msg x = 
+              let g = convertRGBToGray x
+                  t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
+                  g' = let light = cvAndS (255,0,0) . convertGrayToRGB $ t
+                           dark = cvAndS (180,0,0) . convertGrayToRGB 
+                                . thresholdBinaryInv 100 255 $ t
+                       in cvOr light dark
+                  neon = smoothGaussian 3 . dilate 1 . convertGrayToRGB 
+                       . canny 70 110 3 $ g
+              in g' `par` neon `pseq` msg (add neon g')
+
+-- Two-tone blueprint video save to video.
+main11 = do rater <- trackRate
+            cam <- createCameraCapture (Just 0)
+            write <- createVideoWriter "blueprint.mp4" mpeg4CC 15 (640,480)
+            str <- prepFont ComplexSerif False 1 1 2
+            let str' = str (300,450) (0,255,0) . (++ " FPS")
+            runWindow $ proc . str' <$> rater <*> cam >>=
+                        (>>) <$> write <*> return
+    where proc msg x = 
+              let g = convertRGBToGray x
+                  t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
+                  g' = let light = cvAndS (255,0,0) . convertGrayToRGB $ t
+                           dark = cvAndS (180,0,0) . convertGrayToRGB 
+                                . thresholdBinaryInv 100 255 $ t
+                       in cvOr light dark
+                  neon = smoothGaussian 3 . dilate 1 . convertGrayToRGB 
+                       . canny 70 110 3 $ g
+              in g' `par` neon `pseq` msg (add neon g')
+
+main = main5
diff --git a/src/Examples/CamCanny/Rate.hs b/src/Examples/CamCanny/Rate.hs
new file mode 100644
index 0000000..15e55e0
--- /dev/null
+++ b/src/Examples/CamCanny/Rate.hs
@@ -0,0 +1,22 @@
+module Rate where
+import Data.IORef
+import Data.Time.Clock
+import Text.Printf
+
+trackRate :: IO (IO String)
+trackRate = do numFrames <- newIORef 0
+               oldRate <- newIORef ""
+               startTime <- getCurrentTime >>= newIORef
+               return $ do n <- readIORef numFrames
+                           if n == 30 then
+                             do t <- getCurrentTime
+                                s <- readIORef startTime
+                                let dt = realToFrac $ diffUTCTime t s :: Float
+                                    msg = printf "%.2f" (30.0 / dt)
+                                writeIORef startTime t
+                                writeIORef numFrames 0
+                                writeIORef oldRate msg
+                                return msg
+                           else
+                             do writeIORef numFrames (n+1)
+                                readIORef oldRate

From f7630c425d033e3473fa475141b05d2fcb78f99c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Fri, 27 May 2011 12:44:30 -0400
Subject: [PATCH 078/137] Export Word8 and Word16 from HighCV. Added
 contrastBoost to CamCanny.

---
 src/AI/CV/OpenCV/HighCV.hs        | 2 +-
 src/Examples/CamCanny/CamCanny.hs | 7 ++++++-
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 8f52785..70bd25f 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -9,7 +9,7 @@ module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic,
                             fromPGM16, toFile, fromPtr, normalize,
                             withImagePixels, sampleLine, Connectivity(..), 
                             fromPixels, resize, getROI, CvRect(..),
-                            cv_L2, cv_MinMax,
+                            cv_L2, cv_MinMax, Word8, Word16,
                             InterpolationMethod(..), MonoChromatic, 
                             TriChromatic, HasChannels, HasDepth,
                             GrayImage, ColorImage, GrayImage16, 
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
index 813b0a2..0533d47 100644
--- a/src/Examples/CamCanny/CamCanny.hs
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -34,12 +34,17 @@ main3 = createCameraCapture (Just 0) >>= runWindow . fmap proc
 main5 = createCameraCapture (Just 0) >>= runWindow . fmap proc
     where proc x = let g = convertRGBToGray x :: GrayImage
                    in halvsies (convertGrayToRGB . normalize cv_MinMax 200 50 $ g)
-                               (convertGrayToRGB g) 
+                               (convertGrayToRGB . contrastBoost $ g) 
     --where proc x = halvsies (sub x . sub x . smoothGaussian 5 $ x) x
     -- where proc x = let d = convertScale 5 0 (absDiff x (smoothGaussian 5 x))
     --                    m = thresholdBinary 50 255 (convertRGBToGray d)
     --               in halvsies (subMask d m x) x
 
+contrastBoost :: GrayImage -> GrayImage
+contrastBoost = normalize cv_MinMax 255 0 
+              . thresholdTruncate (200::Word8)
+              . thresholdToZero 20
+
 halvsies :: ColorImage -> ColorImage -> ColorImage
 halvsies l r = cvOr l' r'
     where l' = resetROI . set (0,0,0) . setROI (CvRect 320 0 320 480) $ l

From 6f095864daec0ba77435787405e36d2771c8128d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 27 May 2011 18:23:43 -0400
Subject: [PATCH 079/137] Took out the unused mouse callback argument to
 namedWindow.

---
 src/AI/CV/OpenCV/GUI.hs           | 4 ++--
 src/Examples/CamCanny/CamCanny.hs | 2 +-
 src/Examples/CamCanny/Rate.hs     | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index 698cdd5..fb6072e 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -37,9 +37,9 @@ runNamedWindow name mkImg =
 -- alive.
 namedWindow :: (HasChannels c, HasDepth d) => 
                String -> [WindowFlag] -> 
-               Maybe MouseCallback -> 
+               --Maybe MouseCallback -> 
                IO (HIplImage c d -> IO (), IO ())
-namedWindow name flags _cb =
+namedWindow name flags =
   do cstr <- newCString name
      let showImg img = withHIplImage img $ \imgPtr ->
                          cvShowImage cstr (fromArr imgPtr)
diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
index 0533d47..f020861 100644
--- a/src/Examples/CamCanny/CamCanny.hs
+++ b/src/Examples/CamCanny/CamCanny.hs
@@ -141,4 +141,4 @@ main11 = do rater <- trackRate
                        . canny 70 110 3 $ g
               in g' `par` neon `pseq` msg (add neon g')
 
-main = main5
+main = main10
diff --git a/src/Examples/CamCanny/Rate.hs b/src/Examples/CamCanny/Rate.hs
index 15e55e0..bcd3597 100644
--- a/src/Examples/CamCanny/Rate.hs
+++ b/src/Examples/CamCanny/Rate.hs
@@ -8,7 +8,7 @@ trackRate = do numFrames <- newIORef 0
                oldRate <- newIORef ""
                startTime <- getCurrentTime >>= newIORef
                return $ do n <- readIORef numFrames
-                           if n == 30 then
+                           if n == 29 then
                              do t <- getCurrentTime
                                 s <- readIORef startTime
                                 let dt = realToFrac $ diffUTCTime t s :: Float

From 8c5793a80eb3d7c25fd542ff833833135a88fa11 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 27 May 2011 20:27:19 -0400
Subject: [PATCH 080/137] Added a more granular performance counter that can be
 used to selectively measure time spent in certain activities rather than
 total time.

---
 src/Examples/CamCanny/Rate.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/src/Examples/CamCanny/Rate.hs b/src/Examples/CamCanny/Rate.hs
index bcd3597..ed825c4 100644
--- a/src/Examples/CamCanny/Rate.hs
+++ b/src/Examples/CamCanny/Rate.hs
@@ -20,3 +20,25 @@ trackRate = do numFrames <- newIORef 0
                            else
                              do writeIORef numFrames (n+1)
                                 readIORef oldRate
+
+perfMon :: IO (IO (), IO String, IO ())
+perfMon = do numFrames <- newIORef 0
+             oldRate <- newIORef ""
+             startTime <- getCurrentTime >>= newIORef
+             totalTime <- newIORef 0
+             let start = getCurrentTime >>= writeIORef startTime
+                 stop = do t <- getCurrentTime
+                           s <- readIORef startTime
+                           let dt = realToFrac $ diffUTCTime t s :: Double
+                           modifyIORef totalTime (($!) (+ dt))
+                           n <- readIORef numFrames
+                           if n == 29 then
+                             do oy <- readIORef totalTime
+                                msg <- readIORef totalTime >>= 
+                                       return . printf "%d" . (round::Double->Int) . (30.0 /)
+                                writeIORef numFrames 0
+                                writeIORef totalTime 0
+                                writeIORef oldRate msg
+                           else writeIORef numFrames (n+1)
+
+             return (start, readIORef oldRate, stop)

From acf091c2c9984951e1871e63a700864a09ecadaf Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 27 May 2011 20:27:45 -0400
Subject: [PATCH 081/137] Wrapped some more array operations: cmpS, avg,
 avgMask, not.

---
 src/AI/CV/OpenCV/ArrayOps.hs           |  68 ++++++++++++-
 src/AI/CV/OpenCV/Core/CxCore.hsc       |   9 ++
 src/AI/CV/OpenCV/Core/HIplImage.hsc    |  23 ++++-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c   |   6 ++
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h   |   1 +
 src/Examples/CamCanny/Makefile         |   6 +-
 src/Examples/CamCanny/VideoFunhouse.hs | 128 +++++++++++++++++++++++++
 7 files changed, 232 insertions(+), 9 deletions(-)
 create mode 100644 src/Examples/CamCanny/VideoFunhouse.hs

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 6c2865b..2b02ae3 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -3,12 +3,17 @@
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
                               cvAnd, andMask, scaleAdd, cvAndS,
                               cvOr, cvOrS, set, setROI, resetROI,
-                              mul, mulS, add, addS, sub,
-                              subMask) where
+                              mul, mulS, add, addS, sub, subMask,
+                              cmpS, avg, avgMask, cvNot,
+                              ComparisonOp(..)) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
-import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..))
+import Foreign.Marshal.Array
+import System.IO.Unsafe (unsafePerformIO)
+import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..), CmpOp(..), 
+                                 IplArrayType, cmpEq, cmpGT, cmpGE, cmpLT, 
+                                 cmpLE, cmpNE)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 
@@ -227,11 +232,66 @@ foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
 foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
   c_cvResetImageROI :: Ptr IplImage -> IO ()
 
+-- |Set an image's region-of-interest.
 setROI :: (HasChannels c, HasDepth d) => 
           CvRect -> HIplImage c d -> HIplImage c d
 setROI (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
 {-# INLINE setROI #-}
 
+-- |Clear any region-of-interest set for an image.
 resetROI :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
 resetROI = cv $ \img -> c_cvResetImageROI img
-{-# INLINE resetROI #-}
\ No newline at end of file
+{-# INLINE resetROI #-}
+
+foreign import ccall "opencv2/core/core_c.h cvCmpS"
+  c_cvCmpS :: Ptr CvArr -> CDouble -> Ptr CvArr -> CInt -> IO ()
+
+data ComparisonOp = CmpEq | CmpGT | CmpGE | CmpLT | CmpLE | CmpNE
+
+cmpToCmp :: ComparisonOp -> CInt
+cmpToCmp CmpEq = unCmpOp $ cmpEq
+cmpToCmp CmpGT = unCmpOp $ cmpGT
+cmpToCmp CmpGE = unCmpOp $ cmpGE
+cmpToCmp CmpLT = unCmpOp $ cmpLT
+cmpToCmp CmpLE = unCmpOp $ cmpLE
+cmpToCmp CmpNE = unCmpOp $ cmpNE
+
+-- |Per-element comparison of an array and a scalar.
+cmpS :: HasDepth d => 
+        ComparisonOp -> d -> HIplImage MonoChromatic d -> 
+        HIplImage MonoChromatic Word8
+cmpS op v = cv2 $ \src dst ->
+            c_cvCmpS (castPtr src) v' (castPtr dst) (cmpToCmp op)
+    where v' = realToFrac . toDouble $ v
+{-# INLINE cmpS #-}
+
+foreign import ccall "HOpenCV_wrap.h c_cvAvg"
+  c_cvAvg :: Ptr CvArr -> Ptr CvArr -> Ptr CDouble -> IO ()
+
+avgWorker :: (IplArrayType a, IsCvScalar b) => Ptr a -> Ptr a -> IO b
+avgWorker img mask = allocaArray 4 $ 
+                     \arr -> do c_cvAvg (castPtr img) (castPtr mask) arr
+                                [r,g,b,a] <- peekArray 4 arr
+                                return $ fromCvScalar (r,g,b,a)
+
+-- |Calculates the mean independently for each channel.
+avg :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
+       HIplImage c d -> CvScalar c d
+avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr
+{-# NOINLINE avg #-}
+
+-- |@avgMask img mask@ calculates the mean independently for each
+-- channel for each element of the source array whose entry in @mask@
+-- is non-zero.
+avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
+           HIplImage c d -> HIplImage MonoChromatic Word8 -> CvScalar c d
+avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
+                   withHIplImage mask $ avgWorker src
+{-# NOINLINE avgMask #-}
+
+foreign import ccall "opencv2/core/core_c.h cvNot"
+  c_cvNot :: Ptr CvArr -> Ptr CvArr -> IO ()
+
+-- |Per-element bit-wise inversion.
+cvNot :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
+cvNot = cv2 $ \src dst -> c_cvNot (castPtr src) (castPtr dst)
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index f6e1221..6ecb579 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -348,6 +348,15 @@ foreign import ccall "opencv2/core/core_c.h cvNormalize"
   cvNormalize :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                  Ptr CvArr -> IO ()
 
+newtype CmpOp = CmpOp { unCmpOp :: CInt }
+#{enum CmpOp, CmpOp
+  , cmpEq = CV_CMP_EQ
+  , cmpGT = CV_CMP_GT
+  , cmpGE = CV_CMP_GE
+  , cmpLT = CV_CMP_LT
+  , cmpLE = CV_CMP_LE
+  , cmpNE = CV_CMP_NE }
+
 -- |Convert null pointers to 'Nothing' and non-null pointers to 'Just'
 -- values.
 ptrToMaybe :: Ptr a -> Maybe (Ptr a)
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index dbbbf69..4fa64e4 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -104,14 +104,29 @@ instance HasDepth d => HasScalar TriChromatic d where
 
 class IsCvScalar x where
     toCvScalar :: x -> (CDouble, CDouble, CDouble, CDouble)
+    fromCvScalar :: (CDouble, CDouble, CDouble, CDouble) -> x
+
+instance IsCvScalar Word8 where
+    toCvScalar = depthToScalar
+    fromCvScalar (r,_,_,_) = floor r
+
+instance IsCvScalar Word16 where
+    toCvScalar = depthToScalar
+    fromCvScalar (r,_,_,_) = floor r
+
+instance IsCvScalar Float where
+    toCvScalar = depthToScalar
+    fromCvScalar (r,_,_,_) = realToFrac r
+
+instance IsCvScalar Double where
+    toCvScalar = depthToScalar
+    fromCvScalar (r,_,_,_) = realToFrac r
 
-instance IsCvScalar Word8 where toCvScalar = depthToScalar
-instance IsCvScalar Word16 where toCvScalar = depthToScalar
-instance IsCvScalar Float where toCvScalar = depthToScalar
-instance IsCvScalar Double where toCvScalar = depthToScalar
 instance (HasDepth d, IsCvScalar d) => IsCvScalar (d,d,d) where
     toCvScalar (r,g,b) = let f = realToFrac . toDouble
                          in (f r, f g, f b, 0)
+    fromCvScalar (r,g,b,_) = let f = fromDouble . realToFrac 
+                             in (f r, f g, f b)
 
 depthToScalar :: HasDepth d => d -> (CDouble, CDouble, CDouble, CDouble)
 depthToScalar x = let x' = realToFrac (toDouble x)
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index 52425ea..88271c8 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -176,6 +176,12 @@ void c_cvSetRoi(IplImage* img, int x, int y, int width, int height)
   cvSetImageROI(img, cvRect(x,y,width,height));
 }
 
+void c_cvAvg(const CvArr *img, const CvArr *mask, double* avg)
+{
+  CvScalar s = cvAvg(img, mask);
+  memcpy(avg, s.val, 4*sizeof(double));
+}
+
 
 /****************************************************************************/
 /*
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 6d13834..72b05a4 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -40,6 +40,7 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
                      int header_size, int mode, int method, int offset_x, 
                      int offset_y);
 
+void c_cvAvg(const CvArr *img, const CvArr *mask, double* avg);
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,
diff --git a/src/Examples/CamCanny/Makefile b/src/Examples/CamCanny/Makefile
index ae7d564..e3e84ee 100644
--- a/src/Examples/CamCanny/Makefile
+++ b/src/Examples/CamCanny/Makefile
@@ -1,4 +1,8 @@
-all:	CamCanny.hs
+all:	CamCanny.hs Rate.hs
 	ghc -O3 CamCanny.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
 
+fun:	VideoFunhouse.hs Rate.hs
+	ghc -O3 VideoFunhouse.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
+
+
 # Show stats on termination: ./CamCanny +RTS -s
\ No newline at end of file
diff --git a/src/Examples/CamCanny/VideoFunhouse.hs b/src/Examples/CamCanny/VideoFunhouse.hs
new file mode 100644
index 0000000..3ac16b8
--- /dev/null
+++ b/src/Examples/CamCanny/VideoFunhouse.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE FlexibleInstances #-}
+import AI.CV.OpenCV.HighCV
+import AI.CV.OpenCV.ArrayOps
+import AI.CV.OpenCV.Filtering
+import Control.Applicative
+import Control.Parallel
+import System.Exit (exitSuccess)
+import Rate
+
+edges = convertGrayToRGB . canny 70 110 3 . convertRGBToGray
+{-# INLINE edges #-}
+
+edgesOnSmoothed x = let e = edges x; s = smooth x in e `par` s `pseq` add e s
+  where edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
+              . canny 70 110 3 . convertRGBToGray
+        smooth = smoothGaussian 21
+{-# INLINE edgesOnSmoothed #-}
+
+-- I find running with +RTS -N2 on a dual core CPU with
+-- hyper-threading to be faster than -N. The presence of HT looks like
+-- more cores, but they don't seem to be helping.
+blueprint x = toned `par` neon `pseq` add neon toned
+  where g = convertRGBToGray x
+        t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
+        light = cvAndS (255,0,0) . convertGrayToRGB $ t
+        dark = cvAndS (180,0,0) . convertGrayToRGB 
+             . cvNot $ t
+        toned = light `par` dark `pseq` cvOr light dark
+        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
+             . canny 70 110 3 $ g
+{-# INLINE blueprint #-}
+
+close :: GrayImage -> GrayImage
+close = erode 4 . dilate 4
+{-# INLINE close #-}
+
+-- No parallelism
+blueprintSlow x = add neon toned
+  where g = convertRGBToGray x
+        t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
+        light = cvAndS (255,0,0) . convertGrayToRGB $ t
+        dark = cvAndS (180,0,0) . convertGrayToRGB 
+             . thresholdBinaryInv 100 255 $ t
+        toned = cvOr light dark
+        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
+             . canny 70 110 3 $ g
+{-# INLINE blueprintSlow #-}
+
+-- Four blue tones.
+blueprint2 x = toned `par` neon `pseq` add neon toned
+  where g = convertRGBToGray x
+        t = close . thresholdBinaryOtsu 255 $ g
+        light = let lightMean = avgMask g t
+                    l1 = close $ cmpS CmpGT lightMean g
+                    l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
+                in cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
+                   cvAndS (220,0,0) l2
+        -- light = cvAndS (255,0,0) . convertGrayToRGB $ t
+        -- dark = cvAndS (180,0,0) . convertGrayToRGB 
+        --      . thresholdBinaryInv 100 255 $ t
+        dark = let t' = cvNot t
+                   darkMean = avgMask g t'
+                   d2 = close $ cmpS CmpLT darkMean g
+                   d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
+               in cvAndS (180,0,0) d1 `cvOr`
+                  cvAndS (140,0,0) (convertGrayToRGB d2)
+        toned = cvOr light dark
+        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
+             . canny 70 110 3 $ g
+{-# INLINE blueprint2 #-}
+
+blueprint2slow x = add neon toned
+  where g = convertRGBToGray x
+        t = close . thresholdBinaryOtsu 255 $ g
+        -- light = cvAndS (255,0,0) . convertGrayToRGB $ t
+        light = let lightMean = avgMask g t
+                    l1 = close $ cmpS CmpGT lightMean g
+                    l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
+                in cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
+                   cvAndS (220,0,0) l2
+        dark = let t' = cvNot t
+                   darkMean = avgMask g t'
+                   d2 = close $ cmpS CmpLT darkMean g
+                   d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
+               in cvAndS (180,0,0) d1 `cvOr`
+                  cvAndS (140,0,0) (convertGrayToRGB d2)
+        toned = cvOr light dark
+        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
+             . canny 70 110 3 $ g
+{-# INLINE blueprint2slow #-}
+
+
+-- NOTE: trackRate counts all the time in between frames. In low-light
+-- situations, a camera may run at a lower rate to effect a longer
+-- exposure time. To still report a useful performance metric, the
+-- perfMon monitor counts only the time a frame is being processed and
+-- drawn.
+
+main = do cam <- createCameraCapture (Just 0)
+          (showImg,close) <- namedWindow "Video Funhouse" [AutoSize]
+          --rater <- trackRate
+          (startFrame', curr, stopFrame) <- perfMon
+          str <- prepFont ComplexSerif False 1 1 2
+          let showFPS :: IO (ColorImage -> ColorImage)
+              --showFPS = str (300,450) (0,255,0) . (++ " FPS") <$> rater
+              showFPS = str (300,450) (0,255,0) . (++ " FPS") <$> curr
+              startFrame x = startFrame' >> return x
+              checkKey b _ 49 = go b id              -- 1
+              checkKey b _ 50 = go b edges           -- 2
+              checkKey b _ 51 = go b edgesOnSmoothed -- 3
+              checkKey b _ 52 = go b blueprint       -- 4 
+              checkKey b _ 53 = go b blueprintSlow   -- 5
+              checkKey b _ 54 = go b blueprint2      -- 6
+              checkKey b _ 55 = go b blueprint2slow  -- 7
+              checkKey b p 102 = go (not b) p
+              checkKey _ _ 27 = close >> exitSuccess
+              checkKey b p _ = go b p
+              go False proc = cam >>= startFrame >>= showImg . proc >> stopFrame >> 
+                              waitKey 1 >>= maybe (go False proc) (checkKey False proc)
+              go True proc = cam >>= startFrame >>= (showFPS <*>) . pure . proc >>= 
+                             showImg >> stopFrame >> waitKey 1 >>=
+                             maybe (go True proc) (checkKey True proc)
+              -- go False proc = cam >>= showImg . proc >> waitKey 1 >>=
+              --                 maybe (go False proc) (checkKey False proc)
+              -- go True proc = cam >>= (showFPS <*>) . pure . proc >>= showImg >>
+              --                waitKey 1 >>= 
+              --                maybe (go True proc) (checkKey True proc)
+          go False id
\ No newline at end of file

From ed0b5d0ef66600d6df7f76c3ffafffe9fec17174 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 31 May 2011 20:52:30 -0400
Subject: [PATCH 082/137] Made cv and cv2 polymorphic in the kind of Ptr they
 work with.

---
 src/AI/CV/OpenCV/ArrayOps.hs           | 68 +++++++++++-------------
 src/AI/CV/OpenCV/Contours.hsc          |  2 +-
 src/AI/CV/OpenCV/Core/CV.hsc           | 11 ++--
 src/AI/CV/OpenCV/Core/CVOp.hs          | 71 +++++++++++++++++---------
 src/AI/CV/OpenCV/Core/CxCore.hsc       |  5 +-
 src/AI/CV/OpenCV/Core/HIplImage.hsc    |  6 ++-
 src/AI/CV/OpenCV/Core/HighGui.hsc      | 42 +++++++--------
 src/AI/CV/OpenCV/Drawing.hs            |  5 +-
 src/AI/CV/OpenCV/Filtering.hsc         |  2 +-
 src/AI/CV/OpenCV/HighCV.hs             |  3 +-
 src/AI/CV/OpenCV/Motion.hsc            |  2 +-
 src/AI/CV/OpenCV/Threshold.hs          |  5 +-
 src/Examples/CamCanny/Makefile         |  4 +-
 src/Examples/CamCanny/VideoFunhouse.hs |  2 +-
 14 files changed, 118 insertions(+), 110 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 2b02ae3..ba61b1e 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -12,8 +12,7 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Marshal.Array
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..), CmpOp(..), 
-                                 IplArrayType, cmpEq, cmpGT, cmpGE, cmpLT, 
-                                 cmpLE, cmpNE)
+                                 cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
 
@@ -25,8 +24,7 @@ foreign import ccall "opencv2/core/core_c.h cvSubRS"
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
           IsCvScalar s, s ~ CvScalar c d) =>
          s -> HIplImage c d -> HIplImage c d
-subRS value = cv2 $ \src dst -> 
-              c_cvSubRS (castPtr src) r g b a (castPtr dst) nullPtr
+subRS value = cv2 $ \src dst -> c_cvSubRS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar value
 {-# INLINE subRS #-}
 
@@ -38,7 +36,7 @@ absDiff :: (HasChannels c, HasDepth d) =>
            HIplImage c d -> HIplImage c d -> HIplImage c d
 absDiff src1 = cv2 $ \src2 dst -> 
                withHIplImage src1 $ \src1' ->
-                 c_cvAbsDiff (castPtr src1') (castPtr src2) (castPtr dst)
+                 c_cvAbsDiff (castPtr src1') src2 dst
 {-# INLINE absDiff #-}
 
 foreign import ccall "opencv2/core/core_c.h cvConvertScale"
@@ -55,8 +53,7 @@ convertScale :: (HasChannels c, HasDepth d1, HasDepth d2) =>
                 Double -> Double -> HIplImage c d1 -> 
                 HIplImage c d2
 convertScale scale shift  = cv2 $ \src dst ->
-                            c_cvConvertScale (castPtr src) 
-                                             (castPtr dst) 
+                            c_cvConvertScale src dst
                                              (realToFrac scale) 
                                              (realToFrac shift)
 {-# INLINE convertScale #-}
@@ -64,10 +61,9 @@ convertScale scale shift  = cv2 $ \src dst ->
 foreign import ccall "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvAndHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> 
+cvAndHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> 
                IO ()
-cvAndHelper src1 src2 dst mask = c_cvAnd (castPtr src1) (castPtr src2)
-                                         (castPtr dst) (castPtr mask)
+cvAndHelper src1 src2 dst mask = c_cvAnd src1 src2 dst mask
 
 -- |Calculate the per-element bitwise conjunction of two
 -- arrays. Parameters are a mask and two source images. The mask
@@ -80,14 +76,14 @@ andMask :: (HasChannels c, HasDepth d) =>
 andMask mask src1 = cv2 $ \src2 dst -> 
                     withHIplImage src1 $ \src1' -> 
                         withHIplImage mask $ \mask' ->
-                            cvAndHelper src1' src2 dst mask'
+                            cvAndHelper (castPtr src1') src2 dst (castPtr mask')
 {-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
           HIplImage c d -> HIplImage c d ->  HIplImage c d
 cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
-             cvAndHelper src1' src2 dst nullPtr
+             cvAndHelper (castPtr src1') src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAndS"
@@ -98,8 +94,7 @@ foreign import ccall "opencv2/core/core_c.h cvAndS"
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
            s ~ CvScalar c d) => 
           s -> HIplImage c d -> HIplImage c d
-cvAndS s = cv2 $ \img dst -> 
-           c_cvAndS (castPtr img) r g b a (castPtr dst) nullPtr
+cvAndS s = cv2 $ \img dst -> c_cvAndS img r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar s
 {-# INLINE cvAndS #-}
 
@@ -114,24 +109,22 @@ scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c,
               HIplImage c d -> s -> HIplImage c d -> HIplImage c d
 scaleAdd src1 s = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
-                      c_cvScaleAdd (castPtr src1') r g b a 
-                                   (castPtr src2) (castPtr dst)
+                      c_cvScaleAdd (castPtr src1') r g b a src2 dst
     where (r,g,b,a) = toCvScalar s
 {-# INLINE scaleAdd #-}
 
 foreign import ccall "opencv2/core/core_c.h cvMul"
   c_cvMul :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> CDouble -> IO ()
 
-cvMulHelper :: Ptr IplImage -> Ptr IplImage -> Ptr IplImage -> Double -> IO ()
-cvMulHelper src1 src2 dst s = c_cvMul (castPtr src1) (castPtr src2) 
-                                      (castPtr dst) (realToFrac s)
+cvMulHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Double -> IO ()
+cvMulHelper src1 src2 dst s = c_cvMul src1 src2 dst (realToFrac s)
 
 -- |Per-element product of two arrays.
 mul :: (HasChannels c, HasDepth d) => 
        HIplImage c d -> HIplImage c d -> HIplImage c d
 mul src1 = cv2 $ \src2 dst -> 
            withHIplImage src1 $ \src1' ->
-               cvMulHelper src1' src2 dst 1
+               cvMulHelper (castPtr src1') src2 dst 1
 {-# INLINE mul #-}
 
 -- |Per-element product of two arrays with an extra scale factor that
@@ -140,7 +133,7 @@ mulS :: (HasChannels c, HasDepth d) =>
         Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
 mulS scale src1 = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
-                      cvMulHelper src1' src2 dst scale
+                      cvMulHelper (castPtr src1') src2 dst scale
 {-# INLINE mulS #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAdd"
@@ -151,7 +144,7 @@ add :: (HasChannels c, HasDepth d) =>
        HIplImage c d -> HIplImage c d -> HIplImage c d
 add src1 = cv2 $ \src2 dst ->
            withHIplImage src1 $ \src1' ->
-               c_cvAdd (castPtr src1') (castPtr src2) (castPtr dst) nullPtr
+               c_cvAdd (castPtr src1') src2 dst nullPtr
 {-# INLINE add #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAddS"
@@ -161,8 +154,7 @@ foreign import ccall "opencv2/core/core_c.h cvAddS"
 -- |Computes the sum of an array and a scalar.
 addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
         s -> HIplImage c d -> HIplImage c d
-addS scalar = cv2 $ \src dst -> 
-              c_cvAddS (castPtr src) r g b a (castPtr dst) nullPtr
+addS scalar = cv2 $ \src dst -> c_cvAddS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE addS #-}
 
@@ -174,7 +166,7 @@ sub :: (HasChannels c, HasDepth d) =>
        HIplImage c d -> HIplImage c d -> HIplImage c d
 sub img1 = cv2 $ \img2 dst ->
            withHIplImage img1 $ \img1' -> 
-               c_cvSub (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
+               c_cvSub (castPtr img1') img2 dst nullPtr
 {-# INLINE sub #-}
 
 -- |WARNING: Argument order may be confusing! @cvSubMask img2 mask
@@ -187,8 +179,7 @@ subMask :: (HasChannels c, HasDepth d) =>
 subMask img2 mask = cv $ \img1 ->
                     withHIplImage mask $ \mask' -> 
                         withHIplImage img2 $ \img2' ->
-                            c_cvSub (castPtr img1) (castPtr img2') 
-                                    (castPtr img1) (castPtr mask')
+                            c_cvSub img1 (castPtr img2') img1 (castPtr mask')
 {-# INLINE subMask #-}
 
 foreign import ccall "opencv2/core/core_c.h cvOr"
@@ -198,8 +189,8 @@ foreign import ccall "opencv2/core/core_c.h cvOr"
 cvOr :: (HasChannels c, HasDepth d) =>
         HIplImage c d -> HIplImage c d -> HIplImage c d
 cvOr img1 = cv2 $ \img2 dst ->
-            withHIplImage img1 $ \img1' ->
-                c_cvOr (castPtr img1') (castPtr img2) (castPtr dst) nullPtr
+            withHIplImage img1 $ \img1' -> 
+                c_cvOr (castPtr img1') img2 dst nullPtr
 {-# INLINE cvOr #-}
 
 foreign import ccall "opencv2/core/core_c.h cvOrS"
@@ -209,8 +200,7 @@ foreign import ccall "opencv2/core/core_c.h cvOrS"
 -- |Per-element bit-wise disjunction of an array and a scalar.
 cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
          s -> HIplImage c d -> HIplImage c d
-cvOrS scalar = cv2 $ \src dst ->
-               c_cvOrS (castPtr src) r g b a (castPtr dst) nullPtr
+cvOrS scalar = cv2 $ \src dst -> c_cvOrS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE cvOrS #-}
 
@@ -221,8 +211,7 @@ foreign import ccall "opencv2/core/core_c.h cvSet"
 -- |Per-element bit-wise disjunction of an array and a scalar.
 set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
        s -> HIplImage c d -> HIplImage c d
-set scalar = cv $ \src ->
-             c_cvSet (castPtr src) r g b a nullPtr
+set scalar = cv $ \src -> c_cvSet src r g b a nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE set #-}
 
@@ -261,23 +250,23 @@ cmpS :: HasDepth d =>
         ComparisonOp -> d -> HIplImage MonoChromatic d -> 
         HIplImage MonoChromatic Word8
 cmpS op v = cv2 $ \src dst ->
-            c_cvCmpS (castPtr src) v' (castPtr dst) (cmpToCmp op)
+            c_cvCmpS src v' dst (cmpToCmp op)
     where v' = realToFrac . toDouble $ v
 {-# INLINE cmpS #-}
 
 foreign import ccall "HOpenCV_wrap.h c_cvAvg"
   c_cvAvg :: Ptr CvArr -> Ptr CvArr -> Ptr CDouble -> IO ()
 
-avgWorker :: (IplArrayType a, IsCvScalar b) => Ptr a -> Ptr a -> IO b
+avgWorker :: IsCvScalar b => Ptr CvArr -> Ptr CvArr -> IO b
 avgWorker img mask = allocaArray 4 $ 
-                     \arr -> do c_cvAvg (castPtr img) (castPtr mask) arr
+                     \arr -> do c_cvAvg img mask arr
                                 [r,g,b,a] <- peekArray 4 arr
                                 return $ fromCvScalar (r,g,b,a)
 
 -- |Calculates the mean independently for each channel.
 avg :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
        HIplImage c d -> CvScalar c d
-avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr
+avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr . castPtr
 {-# NOINLINE avg #-}
 
 -- |@avgMask img mask@ calculates the mean independently for each
@@ -286,7 +275,7 @@ avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr
 avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
            HIplImage c d -> HIplImage MonoChromatic Word8 -> CvScalar c d
 avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
-                   withHIplImage mask $ avgWorker src
+                   withHIplImage mask $ avgWorker (castPtr src) . castPtr
 {-# NOINLINE avgMask #-}
 
 foreign import ccall "opencv2/core/core_c.h cvNot"
@@ -294,4 +283,5 @@ foreign import ccall "opencv2/core/core_c.h cvNot"
 
 -- |Per-element bit-wise inversion.
 cvNot :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
-cvNot = cv2 $ \src dst -> c_cvNot (castPtr src) (castPtr dst)
+cvNot = cv2 $ \src dst -> c_cvNot src dst
+{-# INLINE cvNot #-}
diff --git a/src/AI/CV/OpenCV/Contours.hsc b/src/AI/CV/OpenCV/Contours.hsc
index 4338866..aad156f 100644
--- a/src/AI/CV/OpenCV/Contours.hsc
+++ b/src/AI/CV/OpenCV/Contours.hsc
@@ -10,7 +10,7 @@ import Foreign.Marshal.Alloc (alloca)
 
 #include <opencv2/core/types_c.h>
 
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvFindContours"
+foreign import ccall "HOpenCV_wrap.h c_cvFindContours"
   c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> 
                       Int -> Int -> Int -> Int -> Int -> IO Int
 
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/AI/CV/OpenCV/Core/CV.hsc
index 5f1943b..f881a6f 100644
--- a/src/AI/CV/OpenCV/Core/CV.hsc
+++ b/src/AI/CV/OpenCV/Core/CV.hsc
@@ -39,7 +39,7 @@ foreign import ccall "opencv2/imgproc/imgproc_c.h cvDilate"
 -- |Dilate the first image using a 3x3 rectangular structuring element
 -- and store the result in the second image. The third parameter is
 -- the number of dilation iterations to perform.
-cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2  -> CInt -> IO ()
+cvDilate :: Ptr CvArr -> Ptr CvArr  -> CInt -> IO ()
 cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) nullPtr iter
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvErode"
@@ -48,8 +48,8 @@ foreign import ccall "opencv2/imgproc/imgproc_c.h cvErode"
 -- |Erode the first image using a 3x3 rectangular structuring element
 -- and store the result in the second image. The third parameter is
 -- the number of erosion iterations to perform.
-cvErode :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO ()
-cvErode src dst iter = c_erode (fromArr src) (fromArr dst) nullPtr iter
+cvErode :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
+cvErode src dst iter = c_erode src dst nullPtr iter
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvHoughLines2"
         c_cvHoughLines2 :: Ptr CvArr -> Ptr CvMemStorage -> CInt -> CDouble -> CDouble -> CInt -> CDouble -> CDouble -> IO (Ptr (CvSeq a))
@@ -92,8 +92,7 @@ cvSampleLine img (x1,y1) (x2,y2) c =
 -- first and the same depth, but it's number of color channels may be
 -- different and must be compatible with the given 'ColorConversion'
 -- code.
-cvCvtColor :: (IplArrayType a, IplArrayType b) => 
-              Ptr a -> Ptr b -> ColorConversion -> IO ()
+cvCvtColor :: Ptr CvArr -> Ptr CvArr -> ColorConversion -> IO ()
 cvCvtColor src dst code = c_cvCvtColor (fromArr src) (fromArr dst) (colorConv code)
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvPyrDown"
@@ -124,7 +123,7 @@ newtype HaarDetectFlag = HaarDetectFlag { unHaarDetectFlag :: CInt }
 combineHaarFlags :: [HaarDetectFlag] -> HaarDetectFlag
 combineHaarFlags = HaarDetectFlag . foldr ((.|.) . unHaarDetectFlag) 0
   
-foreign import ccall unsafe "HOpenCV_wrap.h c_cvHaarDetectObjects"
+foreign import ccall "HOpenCV_wrap.h c_cvHaarDetectObjects"
   c_cvHaarDetectObjects :: Ptr CvArr   -- ^ image
                         -> Ptr CvHaarClassifierCascade -- ^ cascade
                         -> Ptr CvMemStorage            -- ^ storage
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index e3f417a..73c7969 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
-import AI.CV.OpenCV.Core.CxCore (IplImage)
+import AI.CV.OpenCV.Core.CxCore (IplArrayType)
 import AI.CV.OpenCV.Core.HIplUtil
 import Control.Monad ((>=>), void)
 import Data.Monoid
@@ -10,66 +11,86 @@ import Foreign.ForeignPtr
 import System.IO.Unsafe
 
 -- |A CV operation is an IO function on a 'HIplImage'.
-newtype CVOp c d = CVOp { op :: Ptr IplImage -> IO () }
-
-cv :: (HasChannels c, HasDepth d) => 
-      (Ptr IplImage -> IO a) -> HIplImage c d -> HIplImage c d
-cv = runCV . CVOp . (void .)
+newtype CVOp c d e = CVOp { op :: Ptr e -> IO () }
+
+cv :: forall a c d e.
+      (HasChannels c, HasDepth d, IplArrayType e) => 
+      (Ptr e -> IO a) -> HIplImage c d -> HIplImage c d
+cv = runCV . mkCVOp
+    where mkCVOp :: (Ptr e -> IO a) -> CVOp c d e
+          mkCVOp = CVOp . (void .)
 {-# INLINE cv #-}
 
-instance Monoid (CVOp c d) where
+instance Monoid (CVOp c d e) where
   mempty = CVOp . const $ return ()
   CVOp f `mappend` CVOp g = CVOp (\x -> g x >> f x)
   {-# INLINE mappend #-}
 
 withClone :: (HasChannels c, HasDepth d) =>
-             (Ptr IplImage -> IO a) -> HIplImage c d -> IO (HIplImage c d)
-withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f x >> fromPtr x)
+             (Ptr e -> IO a) -> HIplImage c d -> IO (HIplImage c d)
+withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f (castPtr x) >> 
+                                                               fromPtr x)
 
 -- |Run a 'CVOp'.
 runCV :: (HasChannels c, HasDepth d) => 
-         CVOp c d -> HIplImage c d -> HIplImage c d
+         CVOp c d e -> HIplImage c d -> HIplImage c d
 runCV = (unsafePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
 -- Apply a binary function to the same argument twice.
-dupArg :: (Ptr IplImage -> Ptr IplImage -> IO ()) -> Ptr IplImage -> IO ()
+dupArg :: (Ptr e -> Ptr e -> IO ()) -> Ptr e -> IO ()
 dupArg f = \x -> f x x
 
 -- |Operations that want an argument /and/ a compatible destination
 -- buffer, but don't need a clone of an input.
-cv2 :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
-       (Ptr IplImage -> Ptr IplImage -> IO a) -> 
-       HIplImage c1 d1 -> HIplImage c2 d2
-cv2 = runBinOp . BinOp . ((void .) .)
+-- cv2 :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+--        (Ptr IplImage -> Ptr IplImage -> IO a) -> 
+--        HIplImage c1 d1 -> HIplImage c2 d2
+-- cv2 = runBinOp . BinOp . ((void .) .)
+cv2 :: forall a c1 d1 c2 d2 e.
+       (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
+        IplArrayType e) => 
+       (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 -> HIplImage c2 d2
+cv2 = runBinOp . mkBinOp
+    where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp (c1,d1) (c2,d2) e
+          mkBinOp = BinOp . ((void .) .)
 {-# INLINE cv2 #-}
 
-bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
+bi2unary :: BinOp (c,d) (c,d) e -> CVOp c d e
 bi2unary = CVOp . dupArg . binop
 
-unary2bi :: CVOp c d -> BinOp (c,d) (c,d)
+unary2bi :: CVOp c d e -> BinOp (c,d) (c,d) e
 unary2bi = BinOp . const . op
 
 (<>) :: Monoid m => m -> m -> m
 (<>) = mappend
 {-# INLINE (<>) #-}
 
-newtype BinOp a b = 
-    BinOp { binop :: Ptr IplImage -> Ptr IplImage -> IO () }
+newtype BinOp a b c = 
+    BinOp { binop :: Ptr c -> Ptr c -> IO () }
 
 -- Compose 'BinOp's for in-place mutation when the types allow it.
-cbop :: BinOp b b -> BinOp a b -> BinOp a b
+cbop :: BinOp b b c -> BinOp a b c -> BinOp a b c
 cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
-withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
-           (Ptr IplImage -> Ptr IplImage -> IO a) ->
+-- withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+--            (Ptr IplImage -> Ptr IplImage -> IO a) ->
+--            HIplImage c1 d1 -> IO (HIplImage c2 d2)
+-- withDst f img = mkHIplImage (width img) (height img) >>= \img2 ->
+--                 withHIplImage img2 (\x -> withHIplImage img (flip f x) >>
+--                                           return img2)
+withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
+            IplArrayType e) => 
+           (Ptr e -> Ptr e -> IO a) ->
            HIplImage c1 d1 -> IO (HIplImage c2 d2)
 withDst f img = mkHIplImage (width img) (height img) >>= \img2 ->
-                withHIplImage img2 (\x -> withHIplImage img (flip f x) >>
+                withHIplImage img2 (\x -> withHIplImage img (flip f (castPtr x) . castPtr) >>
                                           return img2)
 
-runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
-            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 -> HIplImage c2 d2
+
+runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
+             IplArrayType e) => 
+            BinOp (c1,d1) (c2,d2) e -> HIplImage c1 d1 -> HIplImage c2 d2
 runBinOp = (unsafePerformIO .) . withDst . binop
 
 {-# RULES "runCV/fuse"
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 6ecb579..eb8a45e 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -308,9 +308,8 @@ foreign import ccall "HOpenCV_wrap.h c_cvLine"
                     CDouble -> CDouble -> CDouble -> CInt -> 
                     CInt -> CInt -> IO ()
 
-cvLine :: IplArrayType a => Ptr a -> (Int, Int) -> (Int, Int) -> 
-                    (Double, Double, Double) -> Int -> 
-                    Int -> IO ()
+cvLine :: Ptr CvArr -> (Int, Int) -> (Int, Int) -> 
+          (Double, Double, Double) -> Int -> Int -> IO ()
 cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
     c_cvLine (fromArr dst) (fi x1) (fi y1) (fi x2) (fi y2) 
              (fr r) (fr g) (fr b) (fi thickness) (fi lineType) 0 
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 4fa64e4..e378818 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -163,7 +163,7 @@ mkHIplImage w h =
           bpp = bytesPerPixel (undefined::d)
           stride = w * (numChannels (undefined::c) :: Int) * bpp
 
-foreign import ccall unsafe "memset"
+foreign import ccall "memset"
   memset :: Ptr Word8 -> Word8 -> CInt -> IO ()
 
 -- |Prepare a 'HIplImage' of the given width and height. Set all
@@ -243,7 +243,9 @@ instance forall c d. (HasChannels c, HasDepth d) =>
                            then cv_GRAY2BGR
                            else cv_BGR2GRAY
                     ptr' = castPtr ptr :: Ptr IplImage
-                withHIplImage img2 $ \dst -> cvCvtColor ptr' dst conv
+                withHIplImage img2 $ \dst -> cvCvtColor (castPtr ptr') 
+                                                        (castPtr dst) 
+                                                        conv
                 (#peek IplImage, imageDataOrigin) ptr >>= cvFree
                 return $ unsafeCoerce img2
         else do origin' <- (#peek IplImage, origin) ptr
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
index 12e5277..d4f554a 100644
--- a/src/AI/CV/OpenCV/Core/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -26,7 +26,7 @@ import AI.CV.OpenCV.Core.CxCore
 
 ------------------------------------------------
 -- General
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvConvertImage"
+foreign import ccall "opencv2/highgui/highgui_c.h cvConvertImage"
   c_cvConvertImage :: Ptr CvArr -> Ptr CvArr -> CInt -> IO ()
 
 cvConvertImage :: (IplArrayType a, IplArrayType a1) => Ptr a -> Ptr a1 -> CInt -> IO ()
@@ -46,14 +46,14 @@ instance Enum LoadColor where
   toEnum (#const CV_LOAD_IMAGE_UNCHANGED) = LoadUnchanged
   toEnum x = error $ "Unknown LoadColor enum "++show x
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvLoadImage"
+foreign import ccall "opencv2/highgui/highgui_c.h cvLoadImage"
   c_cvLoadImage :: CString -> CInt -> IO (Ptr IplImage)
 
 cvLoadImage :: String -> LoadColor -> IO (Ptr IplImage)
 cvLoadImage fileName col = withCString fileName (flip c_cvLoadImage col')
     where col' = fromIntegral $ fromEnum col
 
-foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header"
+foreign import ccall "HOpenCV_wrap.h debug_print_image_header"
   c_debug_ipl :: Ptr IplImage -> IO ()
 
 foreign import ccall safe "opencv2/highgui/highgui_c.h cvSaveImage"
@@ -68,14 +68,14 @@ cvSaveImage fileName img = withCString fileName $
 data CvCapture
 
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateCameraCapture"
+foreign import ccall "opencv2/highgui/highgui_c.h cvCreateCameraCapture"
   c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture)
                           
 cvCreateCameraCapture :: Int -> IO (Ptr CvCapture)
 cvCreateCameraCapture = errorName "Failed to create camera" . checkPtr . 
                         c_cvCreateCameraCapture . fromIntegral
   
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateFileCapture"
+foreign import ccall "opencv2/highgui/highgui_c.h cvCreateFileCapture"
   c_cvCreateFileCapture :: CString -> IO (Ptr CvCapture)
                           
 cvCreateFileCapture :: String -> IO (Ptr CvCapture)
@@ -83,7 +83,7 @@ cvCreateFileCapture filename = err' . checkPtr $
                                withCString filename c_cvCreateFileCapture
     where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'"
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvSetCaptureProperty"
+foreign import ccall "opencv2/highgui/highgui_c.h cvSetCaptureProperty"
   c_cvSetCaptureProperty :: Ptr CvCapture -> CInt -> CDouble -> IO ()
 
 -- |The current position of a video capture.
@@ -103,10 +103,10 @@ posEnum (PosRatio r) = (#{const CV_CAP_PROP_POS_AVI_RATIO}, realToFrac r)
 setCapturePos :: Ptr CvCapture -> CapturePos -> IO ()
 setCapturePos cap pos = uncurry (c_cvSetCaptureProperty cap) $ posEnum pos
   
--- foreign import ccall unsafe "HOpenCV_wrap.h release_capture"
+-- foreign import ccall "HOpenCV_wrap.h release_capture"
 --   release_capture  :: Ptr CvCapture -> IO ()
 
-foreign import ccall unsafe "HOpenCV_wrap.h &release_capture"
+foreign import ccall "HOpenCV_wrap.h &release_capture"
   cp_release_capture  :: FunPtr (Ptr CvCapture -> IO ())
  
 createCameraCaptureF :: Int -> IO (ForeignPtr CvCapture)
@@ -115,7 +115,7 @@ createCameraCaptureF = createForeignPtr cp_release_capture . cvCreateCameraCaptu
 createFileCaptureF :: String -> IO (ForeignPtr CvCapture)
 createFileCaptureF = createForeignPtr cp_release_capture . cvCreateFileCapture
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvQueryFrame"
+foreign import ccall "opencv2/highgui/highgui_c.h cvQueryFrame"
   c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage)
 
 cvQueryFrame :: Ptr CvCapture -> IO (Maybe (Ptr IplImage))
@@ -130,11 +130,11 @@ fourCC (a,b,c,d) = (c1 .&. 255) + shiftL (c2 .&. 255) 8 +
                    shiftL (c3 .&. 255) 16 + shiftL (c4 .&. 255) 24
     where [c1,c2,c3,c4] = map (fromIntegral . fromEnum) [a,b,c,d]
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvCreateVideoWriter"
+foreign import ccall "opencv2/highgui/highgui_c.h cvCreateVideoWriter"
   c_cvCreateVideoWriter :: CString -> CInt -> CDouble -> CInt -> CInt -> CInt ->
                            IO (Ptr CvVideoWriter)
 
-foreign import ccall unsafe "HOpenCV_wrap.h &release_video_writer"
+foreign import ccall "HOpenCV_wrap.h &release_video_writer"
   cp_release_writer :: FunPtr (Ptr CvVideoWriter -> IO ())
 
 cvCreateVideoWriter :: FilePath -> FourCC -> Double -> (Int, Int) -> 
@@ -150,46 +150,46 @@ createVideoWriterF :: FilePath -> FourCC -> Double -> (Int, Int) ->
 createVideoWriterF fname codec fps sz = createForeignPtr cp_release_writer $
                                         cvCreateVideoWriter fname codec fps sz
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvWriteFrame"
+foreign import ccall "opencv2/highgui/highgui_c.h cvWriteFrame"
   cvWriteFrame :: Ptr CvVideoWriter -> Ptr IplImage -> IO ()
 
 -------------------------------------------------
 -- Windows
-foreign import ccall unsafe "HOpenCV_wrap.h new_window"
+foreign import ccall "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 "HOpenCV_wrap.h del_window"
+foreign import ccall "HOpenCV_wrap.h del_window"
   delWindow :: CInt -> IO ()
 
-foreign import ccall unsafe "HOpenCV_wrap.h show_image"
+foreign import ccall "HOpenCV_wrap.h show_image"
   showImage :: CInt -> Ptr IplImage -> IO ()
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvWaitKey"
+foreign import ccall "opencv2/highgui/highgui_c.h cvWaitKey"
   cvWaitKey :: CInt -> IO CInt
 
 -- New Windowing Code
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvInitSystem"
+foreign import ccall "opencv2/highgui/highgui_c.h cvInitSystem"
   cvInitSystem :: CInt -> Ptr CString -> IO ()
 
 cvInit :: IO ()
 cvInit = cvInitSystem 0 nullPtr
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvNamedWindow"
+foreign import ccall "opencv2/highgui/highgui_c.h cvNamedWindow"
   cvNamedWindow :: CString -> CInt -> IO ()
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvDestroyWindow"
+foreign import ccall "opencv2/highgui/highgui_c.h cvDestroyWindow"
   cvDestroyWindow :: CString -> IO ()
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvShowImage"
+foreign import ccall "opencv2/highgui/highgui_c.h cvShowImage"
   cvShowImage :: CString -> Ptr CvArr -> IO ()
 
 type CMouseCallback = CInt -> CInt -> CInt -> CInt -> Ptr () -> IO ()
 
-foreign import ccall unsafe "opencv2/highgui/highgui_c.h cvSetMouseCallback"
+foreign import ccall "opencv2/highgui/highgui_c.h cvSetMouseCallback"
   cvSetMouseCallback :: CString -> FunPtr CMouseCallback -> Ptr () -> IO ()
 
 foreign import ccall "wrapper"
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
index a669201..78fe686 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -64,7 +64,7 @@ prepFontAlt face italic hscale vscale shear thickness ltype =
     do f <- initFont face italic hscale vscale shear thickness ltype
        let go (x,y) (r,g,b) msg = cv $ \dst -> 
                                   withCString msg $ \msg' ->
-                                      cvPutText (castPtr dst) msg' x y f r g b
+                                      cvPutText dst msg' x y f r g b
            {-# INLINE go #-}
        return $ go
 {-# INLINE prepFontAlt #-}
@@ -74,8 +74,7 @@ putText :: (HasChannels c, HasDepth d) =>
            HIplImage c d -> HIplImage c d
 putText (x,y) (r,g,b) msg = cv $ \dst ->
                             withCString msg $ \msg' ->
-                                cvPutText (castPtr dst) msg' x y defaultFont
-                                          r g b
+                                cvPutText dst msg' x y defaultFont r g b
                                 -- c_cvPutText (castPtr dst) msg' (fi x) (fi y) 
                                 --             (fr r) (fr g) (fr b)
     -- where fi = fromIntegral
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 056d2de..36f11ae 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -9,7 +9,7 @@ import AI.CV.OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
 
-foreign import ccall unsafe "opencv2/imgproc/imgproc_c.h cvSmooth"
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvSmooth"
   c_cvSmooth :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> CDouble -> 
                 CDouble -> IO ()
 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 70bd25f..2ae7bfe 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -156,7 +156,6 @@ resize method w h img =
 normalize :: (HasChannels c, HasDepth d) => 
              ArrayNorm -> CDouble -> CDouble -> HIplImage c d -> HIplImage c d
 normalize ntype a b = cv2 $ \img dst -> 
-                      cvNormalize (castPtr img) (castPtr dst) a b (unNorm ntype) 
-                                  nullPtr
+                      cvNormalize img dst a b (unNorm ntype) nullPtr
 {-# INLINE normalize #-}
              
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index 44c05b5..cb19b93 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -8,7 +8,7 @@ import System.IO.Unsafe
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplImage
 
-foreign import ccall unsafe "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
+foreign import ccall "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
   c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
                            CInt -> CInt -> CInt -> CInt -> 
                            CInt -> Ptr CvArr -> Ptr CvArr -> IO ()
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index b16d9dc..06be1b2 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -11,7 +11,7 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
-import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Ptr (Ptr)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
@@ -42,8 +42,7 @@ cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                HIplImage MonoChromatic d2
 cvThreshold threshold maxValue tType = 
     cv2 $ \src dst ->
-        do _r <- c_cvThreshold (castPtr src) (castPtr dst) 
-                               threshold' maxValue' tType'
+        do _r <- c_cvThreshold src dst threshold' maxValue' tType'
            return ()
            --return (fromDouble (realToFrac r)) -- FIXME: This is dropped by cv2!
     where threshold' = realToFrac . toDouble $ threshold
diff --git a/src/Examples/CamCanny/Makefile b/src/Examples/CamCanny/Makefile
index e3e84ee..450e040 100644
--- a/src/Examples/CamCanny/Makefile
+++ b/src/Examples/CamCanny/Makefile
@@ -2,7 +2,7 @@ all:	CamCanny.hs Rate.hs
 	ghc -O3 CamCanny.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
 
 fun:	VideoFunhouse.hs Rate.hs
-	ghc -O3 VideoFunhouse.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
+	ghc -O3 VideoFunhouse.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields -fspec-constr-count=15
 
 
-# Show stats on termination: ./CamCanny +RTS -s
\ No newline at end of file
+# Show stats on termination: ./CamCanny +RTS -s -A8M -N
\ No newline at end of file
diff --git a/src/Examples/CamCanny/VideoFunhouse.hs b/src/Examples/CamCanny/VideoFunhouse.hs
index 3ac16b8..4a3a7b3 100644
--- a/src/Examples/CamCanny/VideoFunhouse.hs
+++ b/src/Examples/CamCanny/VideoFunhouse.hs
@@ -25,7 +25,7 @@ blueprint x = toned `par` neon `pseq` add neon toned
         light = cvAndS (255,0,0) . convertGrayToRGB $ t
         dark = cvAndS (180,0,0) . convertGrayToRGB 
              . cvNot $ t
-        toned = light `par` dark `pseq` cvOr light dark
+        toned = cvOr light dark
         neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
              . canny 70 110 3 $ g
 {-# INLINE blueprint #-}

From 5d2ea3f68b7b34093ad68e2e6785b6b210f25374 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 1 Jun 2011 17:43:05 -0400
Subject: [PATCH 083/137] Added the PerfTest module for checking performance
 using Criterion.

---
 src/AI/CV/OpenCV/Core/HIplImage.hsc |  14 +++----
 src/Examples/PerfTest/Makefile      |   4 ++
 src/Examples/PerfTest/PerfTest.hs   |  59 ++++++++++++++++++++++++++++
 src/Examples/PerfTest/lena.jpg      | Bin 0 -> 91814 bytes
 4 files changed, 70 insertions(+), 7 deletions(-)
 create mode 100644 src/Examples/PerfTest/Makefile
 create mode 100644 src/Examples/PerfTest/PerfTest.hs
 create mode 100644 src/Examples/PerfTest/lena.jpg

diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index e378818..cb1ea8a 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -144,13 +144,13 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
 -- pixel depth (e.g. 'Word8', 'Float').
 data HIplImage c d = (HasChannels c, HasDepth d) => 
-                     HIplImage { origin    :: !Int
-                               , width     :: !Int
-                               , height    :: !Int
-                               , imageSize :: !Int
-                               , imageData :: !(ForeignPtr d)
-                               , imageDataOrigin :: !(ForeignPtr d)
-                               , widthStep :: !Int }
+                     HIplImage { origin          :: {-# UNPACK #-} !Int
+                               , width           :: {-# UNPACK #-} !Int
+                               , height          :: {-# UNPACK #-} !Int
+                               , imageSize       :: {-# UNPACK #-} !Int
+                               , imageData       :: {-# UNPACK #-} !(ForeignPtr d)
+                               , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
+                               , widthStep       :: {-# UNPACK #-} !Int }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
diff --git a/src/Examples/PerfTest/Makefile b/src/Examples/PerfTest/Makefile
new file mode 100644
index 0000000..59ef950
--- /dev/null
+++ b/src/Examples/PerfTest/Makefile
@@ -0,0 +1,4 @@
+all:	PerfTest.hs
+	ghc -O3 PerfTest.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -fspec-constr-count=15
+
+# Suggested RTS options: ./PerfTest +RTS -s -A8M -N
\ No newline at end of file
diff --git a/src/Examples/PerfTest/PerfTest.hs b/src/Examples/PerfTest/PerfTest.hs
new file mode 100644
index 0000000..3854d15
--- /dev/null
+++ b/src/Examples/PerfTest/PerfTest.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+import AI.CV.OpenCV.HighCV
+import AI.CV.OpenCV.Core.HIplImage
+import AI.CV.OpenCV.ArrayOps
+import AI.CV.OpenCV.Filtering
+import Control.Parallel
+import Criterion.Main
+import System.IO.Unsafe
+import Control.DeepSeq
+import Foreign.ForeignPtr
+
+-- Morphological closing
+close :: GrayImage -> GrayImage
+close = erode 4 . dilate 4
+{-# INLINE close #-}
+
+-- Posterize into four shades of blue.
+fourTones :: GrayImage -> ColorImage
+fourTones g = cvOr light dark
+    where t = close . thresholdBinaryOtsu 255 $ g
+          lightMean = avgMask g t
+          l1 = close $ cmpS CmpGT lightMean g
+          l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
+          light = cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
+                  cvAndS (220,0,0) l2
+          t' = cvNot t
+          darkMean = avgMask g t'
+          d2 = close $ cmpS CmpLT darkMean g
+          d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
+          dark = cvAndS (180,0,0) d1 `cvOr`
+                 cvAndS (140,0,0) (convertGrayToRGB d2)
+{-# INLINE fourTones #-}
+
+-- Smoothed Canny edges.
+neonEdges :: GrayImage -> ColorImage
+neonEdges = convertGrayToRGB . smoothGaussian 3 . dilate 1 . canny 70 110 3
+{-# INLINE neonEdges #-}
+
+-- A blueprint effect.
+blueprint :: ColorImage -> ColorImage
+blueprint x = toned `par` neon `pseq` add neon toned
+    where g = convertRGBToGray x
+          toned = fourTones g
+          neon = neonEdges g
+{-# INLINE blueprint #-}
+
+-- No parallelism.
+blueprintSlow :: ColorImage -> ColorImage
+blueprintSlow x = add (fourTones g) (neonEdges g)
+    where g = convertRGBToGray x
+{-# INLINE blueprintSlow #-}
+
+instance NFData ColorImage where
+    rnf img = unsafePerformIO (touchForeignPtr $ imageData img) `seq` ()
+
+main = do img <- fromFile "lena.jpg"
+          defaultMain [ 
+              bench "blueprint" $ whnf blueprint img
+            , bench "blueprintSlow" $ whnf blueprintSlow img ]
diff --git a/src/Examples/PerfTest/lena.jpg b/src/Examples/PerfTest/lena.jpg
new file mode 100644
index 0000000000000000000000000000000000000000..f06aa74a57ce3a4129340cd4407ef3c0558e3193
GIT binary patch
literal 91814
zcmbTdbyQnV6g3)Li_=1JD@BV#aA=DbclT1<-K9`y2pTBf7AP9rDOM~%ad!&@_h3c7
z{61Un&-dPBCF`zrGs(GkX3p$=_P$T^PwM~@6$NDl02&$^KpFJ{JUs$<l&oBBU94>F
z7<Jq}diz;<+Ho@~yV~$FD!W+O+cC;H+kCQf31IZ)=LO<FEdind80i1C|2{EL4HFyl
zzlMvAjfIVei;s_oi-(6#Nc;?+fQSGO?-|)MB4QF!Qc`?EG72&ha?~*i+JC(;FmX|x
zNC@x<Nd7;!r!D{~E;;}mfPuyYKqp1RAVquXMf(W=pkbjd?7wUK-wh2N0}~4y2Nw^Y
z01fr!|I_~0+5g8$5&$|XD0EB=EG$e+)X#*V&H*q<vB;SC<*>=MtZ<k;C<G#sf8esn
z*K|{APn@y}T6;#~;Xi*tMg5ZP75i%rP9b3tQ8A$S+js936qS@!baeIf4GfKpZEWp6
z+JACz^z!!c_45x1jEepo6Z<7DJ|#5`lAiG`GwWwTVbQPRlG3u;y84F3rskH`KRvyD
z{R6PUp~<P~nc2Ddg~g4{E%^2hVs~%<?EK;qd3Akrdq;{2866XK8*%;%84cYJ^~NB@
z#A4#dCX>^`vGO2i7Kp&5kWc<m(~ZX>sC`Ol?Ky$}oK<Lp?d-p(|7Xzu?_!Sp{}uHA
zjrsqE{Im!l#6Uw07zQao27vTS#;})s!}^H*vn5l`TCRr+?e66b^|azia+G5)naU5H
zsB?r&qA<1H8VK1{=|9L}akr56eUjI(nT!esx5-=S{L|zjM_Mh_U9n@YB|);!O@@(g
z`WX2;Y+$OOE2*pzE>BF~@&q6?%XH3YP}={V&-K_!Fa9dd6>MwKY*6I|((fz$$~fdn
z8O2a+e787a6iBVWqui)o$DZ44pFBm2EK(jXWnoY9SZ#LuQ5&V9>1W`>>5s2*dta{I
zotES^;k%AR2tyRITC~2Z|DA41=;bWZ7_KKzlryk_yxZ-ie_@3K_An)Pyb{%NsU1#|
zV+3RKAFC+~ePv`N?<Zzy!24AZ=Mg-|g4@+bBFmF}n}1fyXeax3fSO=wezNrgt%+-I
z4S>XME@Di&=l-=eesVGdp7`h2)%yWo5q&~sojgyEx3G#I3jUb(bPm6A7umXztYl?5
zNH}TYpR98xEI+@|5YB>vwpXLGc!Qj9j*Vf`WsLZ$-0$V+xXw8bj%6oa;-8XDNYXj|
zX}uA7(|tbnT}Oj=y2{tQc^S8<w-F|PEoG_MFNI%Lla<>X2M_G&(9tdUw$cS}>aTvk
zr1jg=yp7*Z_PX#Jpw-WA$5k2Ds!=N2@4bAM2mIB$6xE13dfcf3<>obTcSHKK<hFU7
zfWnMHNzv)YI2v6~0G0AzBH8~yw}t>^7S2M_JSQBTVJ1x?)u^e1KA)*w&r#mT7({d>
z3%clFKl-V}PWv0>WR+Kf)8vO-qm@~%+q1LcG@g8XWWc@q3#0fVkpds{g1xK@s0&e`
zgn*vA&8T?U6Tmn{k??J}JI$?i4m`&>fh@R}k)hcic%q^(53@!al*zSRbdq14Wg~)8
zYX*TkKa1;QOEm)l;P<8$t(H?Cjys-PEEd+8NPbJ|I4Z8>kH1n?)c+7Q4L872<5WQm
z?NobIE}cvM+tN=ADf4$c;@%?c7wH;n2$rlFbPC~V_(PFQLs;nDjdN!(4%cJh^om?X
z6r|Pf8LmaXr!mc=KzHmRIakt)9VG(ZJGF)+dU8|+BqpUN$VY}=s|QYU)`@BIk9*xr
zXswu*X+Y|q0MNnM;TS3O&kq_hDs}^-U=lcj>dv~ZRmdc@AV%K~^V}mMe{)0_0%AnV
zxyV}!5>npB=V8umsQ5dyB#SG{niKZS$Ncrp-02gbXZ1zuhmIMe<AhGgw)_w9I{(3d
zif7Mszp~EH%D?>2<h+y@SQ_2CMao^IypB{34dJPg1FZRT$SSO1)t80Bkz1H4{K)$<
zR_%eP^ijEkz1vBbg$3}+h?(?EvK%|L<k^_Yw86qKdCpntsNl3d<(tyz!t9#da`gl^
zW^_LikEu#7n4}YHj0nD7K9F`DoGYVpFkD&2I=WA=Y@Y<H;LS<ls|bmsggUh(8-Xcn
zWigW{J37iIm>G{(z7Eo$SDuXG(N7QJ=^M_(Ec@V8(K#jDz6ct&j8`z4Q33*Z@z`CZ
zWX1yL8t`d1?otGT@Z*$=zI*;UcI;ZpKod{|L`}bJp+5wbKL;T9Kn84P!V1a8^@9bj
z(Hxp(0T>-Ju={<(N1K-HNW6Zj(1sMh=~A}xx8HcBb>{MZk4MLHLnq`8R#WG>rA0Wu
z*XFGIJ^`dVi<Am$?Y^PSlip3H7qPWb8RjrIPRvQio)xi110w3laA@;_Lc^fifu^Qq
zS1;Rg)8&$na(sU!w*)v7rgkGR@=rHQ&6tELC+Wh=&{OyVSXvPGj^tFVH8>yyPL|rG
zwW>)9wmZOqW(uQeL#y{Uc_em-@|dF<l0sVrR?Dni81s=`O2$<8y%Hhim&JMMZ+rK<
z6Z=A|e?O!&yJc^)#5<K>aQd@T_XAmwWy*22lFT6TQ9i(-fWvcPNx%x9dm#OclCW%B
zj$Ov_eHS8y<0YS74k(3xI(ae6z_vZ!fV7V8@GoF&C@>GpdikB%5NC4#rs4;m2R^6T
zERDB$YEYF%!FI?drVIxQ`_$cBiNEjl*k>~nMi2?{RQ|=DR(x#RU)Ebl=De{IE2!Tc
z@8n%N=&ynRKPVCE4-xu^KVg%y+zROSx-T_fvs!DTJr#Tc%vI2X|JEbNBj3Y`mI+Ch
zDEjp_bnkmWiL<C|nBZ&2)dsL>UZ3)d(bP+%>%^ZF^%x&j>AmwU5=kv7y8IyfcB~bV
z$F<8q;Kc8!uk`^;gv2Cq%6>twpAS2|2sEA0BW(+^p?t_*g0&D9dJ0;+3=X^rl8I?(
zoaJHSa+9!@F9`RVp1pmqVHdaEkuttD#91=qo}n{xc&zezjd2t>a1Paje29<*?i$e5
zOm?I@aC{0;nH9DDnr;SL#<(B_KW?T-4Y@<l;alJW=?2J2fzXVzieZfh5;G64yEwPY
z6+jyfWIO{mWb2PNuaydLVe6@T%`qZNH$K}W6t_rd@u#ft$H&}3>}-am*@Cs}rWCIf
z;=ChwERr)5hdOo4G5q}eO3jA7{9aw#v(`w%uY|9FBBbL*NA|xHbN`-6&Pb*CD(+5^
zDEtYKJk!v_ghzq4=wukSEwY9Xt<gUCvYPHhN;p!b&Pf5`5s~WR^wD~3b~_)kKg|Jp
z%c!h81tV^B*wQ|Wt#4su?KmF(;W6I{E!<K1TB)Fm9NRXx*%D(CIlt|2$ICggN`%e*
z2v=RCJ9QOW<3)hQIokgu$<o5t5i(U!$E8=h@80_ZNceL=b5r^gtZM9jzMmwxwQGew
z57D~nB;js>d=E6!8PSuEZ<TKq0YQ(Hf3u8VO0>&q`ITxKdJog{--P9HSuZ4E;Zvl7
zp(jS_vn|Svj`IIx`BNw&71R}^95?y3=>jy{aV#F29Cxx8UUIdo@~5-%>x@sA>5+z0
zcUN4_JG)z!5tRE9h7r$3!p7Rzqo#gI?JYQSHI>m;?g$Xj+DnFTXe%s?S#@7M0c1uC
z%ekWdntieUPE_b|qw}ss8xP<LuRac-kZA8uQGppQXbtme<1#5$%0QT5<s6y-cC5tW
z+djP`E6)qF8p5s`5T82@Em3>(Pergx-?#g}z9oC3j_phPZ?%oz$qt1p#_ST)DUG>Z
zEEdF_F0cS;0a8zZKSf0@STrlk?Gy!!O1>ogV>ky|8r$W3`pY<&m-mh>dU0*-U#@vQ
z`MMg3WqJlw!0y!F`iouFmm{WbKSCfw8qJ`yQZ44xspRPhE%Y{+rhBOKPFCZV!E};J
zg|yX}tm0cWefHoeOnU&@)FRjgXSir66#~3<mlbmkm5F5-s^cA(W5KoiXjb%gtLgU0
zEV(g7@m1N`N8w4JW*6Er+Gqe!(pz}JU;ZA{*M@^pa&SA_&>1t4m#`bCkhlIC1Lw#3
zV=)p6!QU?%0C`LCo6{Noo2!Y=EA&W8$Z=Ps)rm`VBRFre_OBGFZ?&2GRsrvI?}_T_
zd;2;8EW3_iXGjqK*dUzfExRp$>nMPGEVa*HAF14bBG>Pv#KrodVLGA9ZV_+PW1z^7
zf#6<uHltW2Pyc-IVfC2U9FopSJG}xnHIs3W*9sx_sckVT(ASx(<Vw0JT5ofs*cBy_
zw2G6LW9i@;`>cqkP#DO-A|Kk{YTpz1E7|Y6W7A8s$<{&4HeHJC*s7LtO%=1jW#R%q
z)+fMSr|~~mA8k&j(yPmrEpO9!!!=w*ZZy`&5J&AH{xm&&+^sy^`%uW|24TnoPc<1y
zg`O-xl$v#>1Pc2TL+8oowYC@s#lmqg%Fw2=28{_G>1r#pM?89&bDY_4PWH1;cvDkn
zN-KI(11_QGe_8sh$#$Ebi;`4No8}KspO)%7K~jQ>lg576XWsx}aIgHa$<K1!LpE6Q
z`Dvo&9W&P{D*Uz5^5j0O@Ucm(Scg?A1Qm6uO3jA|m}LH+PP$aznk&wg_ve{oLquNr
z!Pb=vi_w}UfPeUGTnexuS6H4li%xPEA`e)xz{ZU(3Y1*Gq9kd9e2JgjH0?EB17ak3
z5^)U$`&$h9>MwQE0Z&ZU;SXgsyBm)$y!y9|KA%H^a|cRbEYjbgZEU!Tl6hWvf&&K@
zdRm{pB<g-WOsL8FG%B$*m+xr%{g|K`jusJ*sBOriacS!{L^D#73=y|P-Qxq5@mOb)
zAWO79dtsY*CuJhm-226tgjTV)_ngzLOfWHqUNm_AMf^6T%CkWgLSDlQ==ZocLamwy
z?=vQy)JVYk*7BWq#T{kGW`8ev6l@>I{K27%IUGI58`I<RvEirkFEY21&F|rIEWqx5
zbq5;<W;-=FKyIrFYCn`(V=$#vsZPNp#&dA;7$zP}oZi1|dER?=f3}*VmphbOF<5k-
zvkh3)U?fBvb5j{jUa@#KU<nxEP}oo_tbjfDbrr94M+2Tb3QM|Hh|*ILMI(2j8=4W-
zlcO{sn^M4;N+s2H#L#_F$c3J*?MW;9Th8xEVy;TSlcjq{?TyiK4QE=ggylay9&Ki0
z5ne65II*Qc`UbsGKXi>D{?q}A9K-kfI6PG7axs|b>VZ=xO!E-xZbl--jmIF(NfU}}
zOB46S7vC``;5yaL0Dc${Zuyd|v7jUUy-AXl{76CpH{c|3+vqM_HJUpv5+H^_E%R7~
zFiTtgvg2g(?P4Hi71|}mZzdB<Sz9SeOC*PZsegQ&-I7*7$>ue284&TFt%(Q#oiADy
zv5mx0IXfuGbJAz6<-%I-vH{rY+GRU1f=Vl?`(dip3w#IlwEwP3Lbbb<VE}I+;vR*`
z`(N&kXjcz_1dj$`d&yZgJrT)+{YqoP<BiK|3x%==qe_yO^bO`Tna-}-$Ip9u{XUj0
zPkb^hEf?H%1Kgz0*{jC*r0%c~3Z^{sT{SlSGtmksjX!Jg`zp;sr#4<OmwA42^yYL@
ziGMR!eEB$fQ!}az!FqQ4NV(qlf{+3;iN%t%8O1;DoExj^{}f&uGw7vH>z$q*C-`rJ
zO|cTG*Rc`w_1ByOn0|0SNn%&A%3tZbmot-ftWEONVbKV-@S_JY;R2WKrMC!E=^2g8
zZ+X$EeM%6L9u+x@_!?|^1JfMdSR;lJe&d|vvIl#>PRyBng8ahJ6@A$Mf|RV$SlGqH
zXy@kP^A_crJLxAnhzrNE20g6$Faav)@&yZRL_=MF&;#c~iPo2Q*@14s_MgUnNS>KZ
z&CGAbYb6|pf`#4@QgVvZbJ`^Ua6D@y&&KT!ERvPE78umw!+c9o7kORlTMdSSoZ)`q
zf)OxbO1g#IoR#=FL2S@>$tK_^XZ*28?srRj>XPCUv-E<Y&u!K`FcwVYfX<P*&Q=TU
zlG5QJ8tcWLnb`Y()1&t?f5vG4X}(AZ_cV!AJcqWKg-11n>x}xZoLHFXY$#}|scLUP
zwpg~sSO8H2rN4j|0nT+K*dbV6t|CWV-$7U`Zz6jbDG?XYAX5?%5co$B>4A=p&3m5A
zQUVu!MmR4njPfHj<-#`r&2hwKpJ)Ba50`S&I`U(k9W>a#PN)(XRPooJPC$(1tl}z=
zSd~9g&xleMo|*$zQ^n|*=nzo%zr<*|{3+V7pg#N#xGGD-(e!B#gqV#GRBG0{Ro-s3
zZy+^Z0Q;)!CZo-JaDsvT0o}+x1w5T_v{B`))X6gaiD-Q&QM%@k4L;fyBYC1@DVJbB
zWo9#i`caQ;dXjVK0hdj4lvLG~CsN$+L_KlXh^}cP9@&q=ru!oj>>p?QUGL^!H75|k
zx(KDu=$-&$H#%h2qZBz2-I6<5>c+J%J@oCGsVL6pFY*SUAMlk#$vla*P#pNc2g*_z
z<LNt{rCms(gcC8iKBGOP?k?`bPW@BaLQei_+CY<p1faLezZ9P^jJ-TOA1?L4CBd4a
zYGVs+{-zI4qM_mfcU&ILvnj#B9+&;EUDmYDe^q?pB|_5!l!#$IaEWiqNQ#br2a(_n
zumDkDMrA*8=h}F@-$CJ(*(4_=nsPT{*`~PNb(ct5^J_gujty#srkasm7x;c`RLeb1
z+jf_?wV}Ru3M2?8A@O=}8Y*i5mK_gcEp!2F!OFCg+=Yax;p!ny@jrcQz!}sm<lO*J
z46W}7ODhYgiM}9fL_u`t_)}^iqYv9#w7Jfv+Y$cko#h_s9B(NZs8CwH)5*Vq=|~4k
zbqre)cdvdFH)<o`Y^{Nf@=x1z&NkM1)L~}%DZW2l>UH0H`DbDI^(R+ci*Fb)mk&;R
zbj<#*KATYn08Vj={BJ<Q3>E*B-;3NWSe!^ZNf*5y&h??*451UwedVN&LsX=WhlAZg
zaFf50{RBY2DGTDbpTevdBPZ{s&wK(%aV-y?`Mg#){4`iH=;G(roD)-MnnMl28WbZO
zV6?%BpN^Z9ErCXXBASYe0<~irrE40TvPfC^<z4MvBG9<QxI<+g9M7u0%1|Y=q{^Qj
zer97QJb1+?Luff?Zt>Z_LSDnJbnFY1R*GH3|3iwIg=yW28h4@~D1DGM@xwJ#%Zjx$
z?r?j#D`i{c_)_L`$czF!LwKc8T5k}z(s{$`$x>oxS!M`&Ek=he9%h{2D*2-kEz{@=
z;}hV`xPhSQQuc~4JT$fOl&aYp8#qRNpl$pkd78{!Flx1v*{^-!GSLO^#MQbfaro`1
zqO-n^<6C#nb&vQz>ifI12_iEKJin{ld($zo`jw^Y&%u>i20%&TCxD)w#2SRi_iGK^
zW-1!>;3y8V>eWpIo*}Cx$p0XZnEmnzfWP0(HKR<Y%ewV^j0WRnDj5}hTTP<HDf9q`
zgX+D`bUIeRKxii-ZwA>AN@3k#*ZcX~F}|wDP>x65uPpSWN^B~3S;>5PX~-Znf&L0N
zE#-xu2iRk^k%trlvO6tLPFX+=&i<>)p|7>Vnq(!E?(P8QVm)mB-|*yq9JkSy0BC7J
zWDr@|^CST{|A5xmhp=P~AU-Y*YvMQWg9k^Opp|EZGv9U#xVuQC0-pf+DiAFZO4$}F
zR$Js=B0LP=qv3Ewn1)3uu_=A<<Usq&f_1{z0*n-qBz3_%?K*5^oh(cfeG6@jN%1>s
z^*|MD2bUGx-4y~E!ptuhKY1wsI4{-Uwf5t(v<n!x-TC?DSpOLfEr}{oeAp<5=aBJx
z9D(iMnL=3#KcO-8!I4zQEbg!;0HNN9XjkiK%|+{g+so}dBRsShlD_*vZ*)usaDYKm
zzLI~{U1ECvocV=h?3#yt&SNs1ncP|PaHjakl<d{*CLba`qniKuQ6xgnjB8|(KrEqO
zm*|jKqu979x&iv;_k{t;Mz*6v6$%ek<_E+IR~8gWkI0WYd9Fh)Y*-jyD*3$rlhmi{
zJ8-*MyA2T?X0uuNZ0!FfNX2#c+j5+qoT)8|dRXpjTkEm_F&L}Qk)n>?^MW7TuO%B+
zMeRYU9~NtHKI)|QYfQ${H@*yP@F;d&&KTSS*$bglDzRGLFB}KRAWkc?f)~>}$SS_O
zu%W;cfOgh7I+hA2zx`ObGRvXkmtd>D9akwnNxU4v0DV+vyW?)H6165;qyTZdx5_AQ
zufqPEM6T2~EP}3s%RS?(YZ~>xC9pvT#GbkH@xqvvqj`)=Z)6}LQ6PShgl+9L93XDM
z_UW2W|3l(mDi{KkdaJ2t6!&qjUy%}20U6PoqGh%H^PGw?&k?T}Kqk(B$^moA66pn{
z>JD()*MwqSCwkj{zCC^b`z9IV*+n9ecdy52phG~yVs|M%MaR1r8-8C63??^~Ev{<-
z6%vTq<{I}vHE+qB{ltcz3*Ojb`Awy>Jlvh%Z?3>Mj=}H04~N;HiHdX$(&LEHPHUGQ
zmdlqN2Ui*x%v)2ACG(_g<KNZ@B=rkIx?qxtvyF#3!^EtU8{{Ws{sYvT9j(49h!qYm
z9%A8}@-yGp)*&=<IfAqW)xf0)Q2xc_Z)V@Tfcw3|j}FAEv?;{xA<`PrcMbFbu4Ci^
zy_~7KTebJY>An*w7)*@Pq0Sz+Gq*nyY|Kgwz#8Ua$bPPgytX{w(qsE&su^4?ztS$#
zb9bqrCjfH46f5Ro-lZ#tewybvL4VeMFKLa-O3^$Tzte%L>C4GMqIqtJ(^<<Pn|Fw0
zdb+~%_7Z37?(ne>d0gKT^~pMzt<`0__oCEubfh>bI{myVCSqJ7EY;tee(HAi=m(B`
zusiwWKCO|PypJFJON<qim*YJWAd_g6KC3MtYMUbcdrpDKqFvFP+WZ;)>&cV$V3H-G
zWkl9uoewozDj*^$!0jT!!c5})m;Eyuq2FC?{I5i<<XCfFIwnyNMkP;;KLHYjM_w&X
zmm3?r`b_$YQ<-XuFkr0s0{V&B!FqKsoQPOB`Xng3f6&q4Pe}<$()Ywr#al{AW_kQ-
z1cNzOa^scIcHMMtWXx(Tn2%3pOvNy&6X1z074QTQE6gTOXn4iMqNfc6K8s3{YA;n~
zQOxKj=%Q1SDod@=Qa1)AZ)yLnkX<KH@PPdwnreP^3<oQ!=S_Q=VI+EtF$EC8?ov?M
z3$3)GemFr6X7IX1KxrS#<t;HMRJ10Bg`AL;CMXv>qiF9R+WGGhm}&+!jqK4<2?``!
z37QPMR?hC({>V9&Yf5*120a38oo-R?_jBg|f!e@p#Il;xZwp;_eSP1^Wc#)_pH?V!
z4`Pyoi^13$lTC+&YMjHg&FCLEI2Bn~@PXZTwr7KsxylzRD>7AkVLgKVl|_CJVHVpL
zjhlsRk_T2XARB)c$3}tB*wh@`e^U&adCv_u5`vq-etdt@kpoq2WFh6Rav*ES2e)g7
znw^CvdsOe)Dpf1z<8U?kQHk_i>C3%ztEp|OQ5h!F)tXbkKgRpFjr{Ei!<7_ohj@uS
zrjVsN{{##y=1?05O<k~vNF#pmWo}z#{@nW;Kgp>+2E1T{4R5D^Y~l%7<f-`Ery=^y
zFxO$S3i%}WzBVs#2p6zhsE97Heb@`%|ITz`0y<GZIq%;;j*9`FzVgci&?#evHt-&C
z(ML0<x+G_;uw!*trA8c~@LI|JxW5;O*1nQ>!|=TRI3ZQd2vQ7L0pAmnj(dhA*e^FH
ztLq*sFy41+nf&2#{;;O~d5cfelbCh=<;=JqXoy-t01uNM1(Gago3d42DB!KEol2|#
z0eYsn-@WoLF3X+LK4NZ_h)GGzWqPkvqO_?DD@X)`s1<Bi&BTD!J}F>5FQzuf#I*kz
z>!E^?4U=!4I<ZiqSR!L;6!`a?Q0nsRYugOme;QK6)Md4%B%X5pfoM5|vkq)O$`Y<Q
zhgn!4*667Rx4H`YABXKDz&My!&{ju$kr@nlDeGMd?!ABI*KTu8HzLQ056Ai(L<3#>
zQek85_WHD^9(+|AOWN+oArjvml|x)8YO0yiNXN8{v(huMOKsSGe<9jtj9UG@TjiiW
zfDm?*Z#i@8PmIy_f7^$n9ZAB&o0~&xrFVcJj$b32`w;u@#oHV_-%SNg_vn9*sCpwe
zz2#otVbd*x6QQ=Do(b%<V%cn%t+%hxJ~;j3N-DCPZ*inur37a=A|mVGPMTiwda0Mn
z;RNq^8Y4Oyn}Xmnp;w<G&tpFaleWJmKAfS4GG%7rS)cJXHIFUtM@W3s_#OBOFq&mF
zt5&9)16DwjUP;_KdfR^J@WMa8*jN9@ng@;~T3)^5+*d*q(rN&TQMx_0hYCsnjq<f<
zMvF4HLxs<njX2P?l1EW1TIR8A?9^^!+WrL@3k5qt44vR?+nyG@Xf#Mvt9Te5IGg(N
zn>+S0v2zIL5<0HWI+z$5FtTW%n8;&$tlzO}#oD+W`7D6F_Z{}AB^4oprG{$nG31~Q
zd#%AhqI&Oj-5*xVjH7g()KP4Y+pWna9{Z?QtOk070BgB>|2u<)>39#doSJNHhZntN
z5prRIJShT!|4_(Vo2xCE%4Tq23N^!2HdD6!M72A18z{=Fxo9EqM&Q_N15cr4Hf6*Z
z`?LN){2|AKw}ui@YHVp-mV7LY8ak*6K7i1FS7aa+2M-Ua=E}%0$!akkOu_ag{5$U)
zE_cZPs3tA)QM;%`(w3op><Lg-H+lDLWzSQ)3!rN0k*6-Ur~Qr>Rkod-WY02^)x#wq
z3*kS|qgYa5Q!XjyIBc?m%BWShMQ$UX=|Nr7Zr!`L;Wapz<V#P0Dr2(Fm_t%Z(qlFn
zy{xxAqT{}mi=@SE#<!2LiHUs%2=^i<zw-xSeqlO=&Amn@!=&x_J}N-|hxqZylVTJ7
z1d#!HS;pkNsQkaFW)4j>Ih5a9v{T!-8>^UGnn+*MDBxjo(4nngF^si4nOMlD4!G(q
z%xqoIUPKLUHJ?o7duUEqd4YB3*pdrA#jxp<W{j@KhlkU!CduA;GsHpLY-lwD>d5Tu
z#3TmrahTe%HQwLvo7T_WJ$6DbFUl(&J|Q1F!sbe$E*`?IxX{s!a~D<@!*26<i5&W<
z3+U?~-+Eq>jqsb5;M=8z6Ay{MnZ7U@luo>R>^NyYFB2<9Wl*!AqqdKq>j`N6vjlL5
z#ZPv<U;)JD?O5iG{?S04f7Lw>EY1OkfPJSITn=srcMHLz4(7&H2am+?1j;mJGIRkD
ze=LoG%rR29D_HL4O`-o!_UZb_EZ?H2jQ;s;*9DCH{`#+~n@d&5wZYI|&D_qXln~=E
zKcA&Xy!EWrgvuN7jmx9Jk?+~QdazqtoSU?3x-d>C{jZN|1sHA$V=Pnyfvw5z;|~mY
zUy9>@mFol&gV)2i)ekW)Y;sV@7@@oqDRRUZm9r(2;8pL(Zk_Y@-`D42M_{Ra&?u=p
z)x{JG2(f1@XEv`^X_9#@SZ!?-#la||NC!BGUmed~br<#Nl0-DoIjMAFeJQ3HLVVv_
zZ{=)WR#23@h|n+8hQg?qZVgfvJzH`%r)pT8RqWb{<Vx2wWVl-fw=ke)Cp1(;;w!{H
z<gawk0aW{rX{nSvI~-StrrSro0X7s3zavy8_=UGcMOV#18@%xLf<D|UYF?MOzfD5m
zx%|F~!_rzjh>0iX@_O{W`GH*VM<8jY61z;ShNJD7l>#22K;Wd=c;1y_eK6Ho_BZSV
z|D&Cr@Xy~o+qqT_Y5%qWE=)Oj$sr=a*g>(nHAJc({a+l_RQdb;S;G}JQ`Kzw{Kn{=
zucI>Id0vD&vGA=h&&<r_&i+OnYeLI>qjFW-dTZDr(ow3VqC-_jMUM@s;+~<uHf(p7
z&J@kJ^a8U(iIomjbvg(M!=JWXqSR&Ds$KWJtg0w2uPLN#uoZoQhc}3SxV(-rfCJ{&
zT0-OaCr59-yd6HO;VL*K^LM=70K2}1cIrL%ygPo99Ov&h=F`<CFC6gQ&btv(hW4pi
zqC>HmC-B5+vq2XOLa$}}{B2W<I3Ft)ij+Ec0i{uOev1ToQAj58M$AhEG0H$9seTtz
zGV2TOJq9GLKCY=;GQ{+<6|yBEFaY%V#&?oxl!|!dExMj*KZDHE-lY%8{_DY<iNjkS
z>h!1U+UfW>GFUg7a-FH6?Q4jizAvM4F2gXmV>EPJoD_70K&1n-ZyK8g<2@$HbzQdZ
zcggr(&GxLW@SNF)$TGkWus;q?MBWns5>h|cS}%EdYa(pZkVfg8Fpr6@fTC%4WpYX3
z$e|=<#2MAeh^N@K@Q%s5YH$~Xu)S7;>d>9@5`SsB?sAN3H0))+!|{maOoaorxv(bO
zHfhKZ!TKL{HPrV7u0%wfgYyyb+m3g1FB*#)a|!Hh#3V`7gLF%~=0OEw&r(rE7_rho
zO#KX-Z?4?m!-K9)K>B&fRc|*`O_px0^Z%*rOcYEa61Pc*)Cu#$VU+=W(}}Esd*}P&
zd#$cKi>Q4>??REIPztVD?`OaxR5biM`r6ei#|K4>JIrkD30}$bGY!H_(fR^A_I=}P
zCHJdcE{1)jt(bv^>XhM3U%Ke{^T#fs*>>OL3Ese{YFyjEf{{+DyY6}_iwO-z_uI+3
zsmuToau8XNuas2i&&u|$2*}I#0xzft`T_emv`+wD$HF7KCjekatEI>(^yjfK)8ePm
z(+WO$aN9QzaQ=oF<rh(9vZ2HESEo@s%U%l_t7D~G@tJLobI1oj$-8j}Gns?S2kEVf
zhWO{8-|ysU(U^?*JaNuofq_;|>O&hmmKUU$pN=AubQ#PF$_*q^g2F83?w|WN=+tST
zk|)-Vi69eL<lBz+kBq>aBn>f;xAaaurZ(wzssErkUXMzTl<Y3nTQd|DMG535#cwkg
z+#cSX-wz(?*k+5=r1}~~x!D|=G??m9vr;a5L|mho8FaFYj{LD*^7m>5q8x=Se`G*!
zOq9-C${p^ua|~XuuZyiPGiU}Gj51J2KRd`nUnzIcmbyyA`{>@{-_d;c2x*rP9=h6l
zRJy9=9@%i>6qcrzX}P}5^UoT0CpA+4qrT2Rh;dQwzJ@36$=}8D{m5uKA+LCsqUaaM
zJC!7wL=H1ACyz6ymXi9`lL&nsH6M`)dcuCbz<Nls!Y*Z^uL;0DB014``E-d9f@kgD
z%~lujD6}6;=#7LV?=70DXkxiO0nFE+X6XQUcurm{)rf!Xvd%=>HZ~h~R|JUm&bqu|
z9v>ejpbQ&vqYMF6tQM6^Y=6TY{L|<$_F>A6dAO~#iv>sz8591fYrtJ0_mVdFFE&n<
zOoAG7;+se@s>=$|k0(Ef)R$ewjy2>%IG*zvRg1Bt>O-zsTw;48u>YPa(@yoeFdrrH
z0Z(qHE}2zJgOpMbYQMi~)u!6?uWzf1GZ<eVX>75_NK&q+Zn}{=@-6mP-$s)UZhfb3
z==&PIymdGOzx+2wAlfZy9Eln}j0>8pj2qP8+y|T~fBT*ENnb!<LDmoi538^`xUVsn
zPU3L>4o?#Gh(cD)3RF;d{-xj>_HIB1*7cQ4mj&hHPXvZ_FHbjmkUpzd8lbzl@V<An
z&yw)w)pf&g*s5yqZiHV7D=WZ?uaxamN0UA)(%OCLqNdYu-bwfMkL*FyRAwddl>UaQ
z20323!ba~*Q`IL|k@MfqUtlKrUymIaWnC4q`f>d-e6cnjF$dh6Ey&38-6hM8c21n8
zGtqn(mzIP*>Fz(`U);M!`Blu8bVyZ17Jx{d>}2bnxPqiyNFO|-HxwBo%>vS&OO%>;
z_~H2Sp-HtMK<j6hRn9lTXpzkACe(L`DU_LKCoYJFneV6(9;BW$43ES?4&08ILTG<&
z0;QDpESR&^)=EcYK*Q6rpOh>z7}4>nSZ-n=4G>*){2cPTWHWy{$AXTp*T$01Y}}fv
zt*%vxh&#fd-dTa^Z1}V#7$8!V#RUJKaW<{ES)IunLIk0*ye#KDkU`^OGU+ob+3)^d
z`k=eepDo*dKeUvk?OK=>-onpy$ppmpA+>E>oB))hBR0^&fGD!!h0U1H32hq4+Im#;
z0pMhU4{H~D8sU{;fxU#5DPnh_J|kT1&md55W2S3_C8i}nZeLMjT(`TC77GR(q;D^O
zUf=TDuO>*XI#F|ay%92F<EMQ*@JX*<dGLx-vHxX5OfhuKr+BHM9Te8m5aoNw2=GEm
zB3A2uEtRG0cGBmUQl@&&EEu8q5?AOevgHv^SaJ>*-S<-1*!O$ROD&$?j?qbmw&2LN
zxz-BL>4rnc9>(VPw$i39DTd@3nt~C#Vh3vth7nnQMmJy~`S@)0shq2Qjay*@mmEQq
zdjORkb}Sm34YC~>H$*sea+|vm40k9A*3qo->?B7hRYm!oFQA6K8rgl1CA8>gfl7L=
zUg|ttVHRP?n-`2J>#7u-UEAtZe74#e`j7uYBO9SbBtZU}E?HX#D)bw%;pA(@f6Unq
zTs&?MVdjd@41w)JkDXPy8E;FbRyU0(ez&26$_21tVjJX5+5#cK%3_VC6gEBCRU0yk
z9Wvn7+>N3Xmq<$OV<#&8c}mhM%r+q(EwY8Ip1JYPU=DSOOmA092<C6=ZzkIg$yXSX
zwp$}l(vPJfxyY%zCqTsQ!vN--#lhYAu1V8tRSs%W5~8tmzR>m&0jF=1bR(SMoxMcU
z_y1;um+mgYe)6Yu<j>s$c`BOxu*lVG9Rxh7LXQA<NMR^W>~RAwYtzg~o!sliv(I8I
z<2$W0QZoLFD4wxS>s9joq0jFotlK{IrtV7M^s0{Mv3z62Rh6Ssb&wX#>m`|(rub%u
z`rPG_Mb|3Z@6*mN1$-+;%G))gqJex@QXLHy54jc*68R22nSG|VMX^;*Ma5Z5C-Y5L
zz3!uxxRU4oPXJ(_!3#hO?vnBVN=D~Is6uu_yp7YN4N^0PpC2uIs!MoXLQe?7d2O`s
zkwE$tEHkAd4f)ccb18cj(f|*LHW7N%T-FqSKMUs&9u?+Jhi|#*HIA3a9bwlowlb^7
zQr3n~uE`-`_tGZ-JVk~WVP+Tvq@-B<B%~Hd{R`I)6GY!JvoyfG^0u2MykD`1`yH(}
zr?P}H$xkdB$UZUEPQFLe@WZMyM$E}<v)L8T{uEalcbOmzNO8%Cu6&e4Y}_!dZ7`nl
zO6$V1aVp22T8h)3G?ogGC&!*wZ~TvB%2=SUZ=^EWiuXql=KzJH(N_jJR6U?7Ayh0_
zZ#vkcvK{mS>^<zq%)0WK=OF&N*$cads@T{`DbzkAb5^(dh-bU_Hc!7V(^ginF0z0o
z@H7N90gOBCsoy{2c$S<}NP;s*dF>U*AdK6#tL!DIl>%F$jsa*5OtEJ{Dab8qW0KNj
z)x}RG^fha*Gs_p4k9uKA6{@kCxU{(i)9zuTpQaAstu0v0gniX2fq9)p4)w01zEkPB
z1feXyvlXI0U3Hzf>n3?D6$NG-&YZq|BztE5=DB~?@*u4`{cE@>=q`WHRP0`H`qZne
zDe&cZBvenqgk`VlxzmL4LS6dOXGX773vvGfqYSfYGaFB9eMZEOG4<R4%2OjLA^6Uf
z;)<?1McRj%COZg8YD~Z2sD|;CMQkmp8wn5taNk2$12XXa_yq8_lXDDum4x@jbq@?I
zKWWg6?8y^<gq%N<{s<1te;%V=W@O`x2KF$Q**cwk&s@Vu$@Gm#(c-M~p0d5RR-$@D
zAv;ttW{@E4(}^dvA)KB4{DJFx-F#eRA&FPG%%6_YqDf_1zJ^7GcuuOwvf!>5ZZT(o
z|NXxImH>8IH4P2M_NXFtr3+0>MP<YDS7<Rim=BYl?pO}SImM%VN?UaN$UZwA`IL{5
zfMz|L`Xmi&BFC9FO2+47f4v46bPi^lmpWn<c{AQag6;DP$pp~oLO34PkN)=N4be2+
zZq~UT$R7<Iqju5gX(WHK@nKwCiXDE>zjEY%5>%doQ>*|(ZWB80NnXICp11X*2xp2J
z!PRLG{&$Xlf7D-4@9iaC^qG)EFlE_k-(U=nVbHg?qgLPaY{tHaipmuOTTisRop#sr
zE^G9tsXcuj<A5*cxxQ~;en`8kOKKUN_~%(UNMW^?jUtwRCm?J!={OPKD8HXbv2p_P
zLUnBiQ-L&sgkK*nwH{{vgSH%8|0V9Z+iT#W%YO%#Uq!fBX?EfOf6`V<&rA0jWl%<r
zsfovF+;|`hN?}_7D#d7U2jzT>a|_CuA#+r&IzY`~!J3KXibU=YLuOs}fcjL1;7cm$
zwb;;pJcw0ebb4aI&TAr1uR-6V%ZjDh6BMK*N7Q&9y}5A;Q~lwKd$dDCP|oSPL}>cv
z9<L3B#KtJ~)m&#+;fvJ90b5M(_&}U_Jz(Rk--kad*N|c7C?kWXidyAb>^%c)x_aVX
zu|mj=+heiI>pXdB?-2++P$N*O@o`GM%ETjl`GHJ^2r@VP@@2c-8tRWNq#G<8j&<gz
zFJ!l6b!iEGD3Hx5Z(9HYL<Q5@E+<|Y5MQDC_P6Y8@u2mn{wWKY$2l2{F;IQf)(Mg9
zSjFCV>Ywj1$8aBQeTtQf#0KxeECj1~dVdoMP>MT0Fd)6QxSko71{w9!;pyW<;<7Ww
zPrZ0QEe?7Pr|(&8OnVu~P}W`U2s>s&Gr~Zt&mmDq8&KyeKCJ-R#%0E_pq7(ZNmY?Z
zW)a&6*D?}Ha`LWwQE+U0wt$~Vm-ZBQr^CAJdZhTwF!GvtxwIQ@3l=n2J>&Qw;;H^c
z7wjo+Q?+f@tW>Opo~q?Sue#wzC*b7dXlFZ2;_0qVZ0b8IXz|Y9$$)(6hXE~!Oq~2C
z@WT9;eJtE*gj%y?UoQLN*U2hi#h-q9nMFYl_gD!vJrG&93yL~rZ&sMhHJgF`f|n@T
z2i0aF!}GfKRKlUV({qd{-z60w!G2M*moN7i3i;uL-?G~0%WH_lC}OuO5v#8ZKKiE;
zY<w<yqoJ7hKBPH!ON!#^{_J+{?_+TPdp*WiO0>4?`3Q^eaKo^2%c-DYoozvtyw%oN
zr2>`F8IavqD^c>uLVFC!M>8qKS*ZAtW{Ki)jAjhgfcl!;NT6q%J!Q&!>=e}&b1E<e
zN)yMB>MSx5fJPJGa|V37+{-u5%O5Q*F2q%H>|bzbGT1#Jw7PmY<QtS;eh@b>Dl~p3
zFm+U-D}D6chBbL`U?YEQ&wxh{9BLQjBmM-4?Ihs6cc@Z??oWs{DiGE{7*T{a(ebXT
zXTs<v^mPT)Mwb*&fPvnjC{=kNW1aT}$>*+h-I~XLM&8HcUT#kj8w4PpY&PWi^7$9f
zAS>aiawTm?er-=VQo4##V!C!$MDwTSvaMxlzq;T^;7Lyl-A@o0*o|qA14iaq6_IMq
zG>%zM+A=eWKHrLn>Vg6>2ubk7;08ktem{n_ibOs-cKv?G4;--2G8f&tBA^II<eVkp
z$RLoFzn?vnIiK{f!6r6&TV|-*I5g*}FOLR7Artexn2zw*bl5b^9kV~{btI88A-!!R
zP656`!Eu0tr74Ekz|4<cq*!<o)e<>~sSd$A1Mb{~w(H#a8%Ul7&nTW`cpx~}@t)UC
zLK!2n1zExAV7=)mTgbbN5!JsMM6_A)2NvaJnR78J^Kv`YVSZ7>N&Al-jK741-4jHv
zp1x6G<?vz$5(~rIJGs+$ePe3^fh>$g@hnHz<$*?0qw>Ov)F@Oy{eo=}b9W*SGj}sG
z{_On)UkW91NAjJm3`s0nxJ{FB^x9k64o{`OaFH%`qCi{wz1dR5%mv!X#qC^?m18sg
z!*G)%G{hXclsj<np3D3-9gCs0dm%bzwil`p=FQ*=eK*<O`sTmf6>beb+HqRyq0s-K
zZwLv;H>CZHQW4M{>(f;zBP;!$4g6&fjs@9|>#H05S4w<KFsN#ABQv+J;htoyNTWW_
z$gM<T>$RX5R&`6>=WhO%P>X_JMCn;LQD9Rk%3F$@D8Cd)(MBQ4w<Qx%ut<Xds|(w1
zt5nt;ODsCY+dVV3*<zbQ6CoWK&wazP^~yzKP|X+yIKQ;S#e9&So|9K+I}x>Ypn0=S
z@-%c(Q~jt(xEv7?>$bP!oV<e3+Imc%AuAC|r#l%NNCDjY1=end<?V~(5UxgkT^qYI
zlt2tS_0ZFM0Ez7X>pT}N$lHW}mSx6o`*t}h5nttLBP$a~i{N}f;k6*H_Ax<ddJjuy
zjQ#wV54qHefpregdT(E&zhNYE*L?yceNxQ~TEu)9QS~TlB|9G?c<5)Ds(I9_bG`Bt
z$^R(8MN5J~B1hLfBI7ZTwo_8va@us{b*d1C?H}%c(bE`FKVqz1*GIPgmKRTwD13b`
ze9;LrvSMHxP|bK@rVB5VQ)VcH-;7mQZu~_Whb+G23Z_$*5WgIBQ}-~-i1s{3SMGv?
zb1n?6T@IJ*+hbZ&l&+rPQi8C9AGnO=zYBcc`XzT?zEieP_tS#Z-2YF%Y2-X2YVVP9
zM}{;Vt2!scDmjHl5^<k(^hfAdCG6(sq_pDno1)sYcX>K#y_pzPT_Yisr)#}#!bLSk
z0{H9a(uF9~7t*MRD3CNid1u|@c{!&>%aORx<g$GH$P9L9dsshYyjKb3J-`2F(5L1Y
zq^dAM0+fjI*~L5Le8&jH3R<@c3QJZEjcS0zL4RudrrlZon`1vq-NfqbL6wh`B?YUN
z*s!z|+5NVRtx6s~*1xWVhT6{L*GA<u8s}4}R&<w{n>oI0s9QDtuyif-8NFsy5rcgx
z54Qxmu_lvKU9H|`RtFCJ*r~OxyIw$-d>S_jHPTI89)H8Zc!;KhK?h(drbo)}Ux_AL
z$0b$+@0%+&%6T1!<>CC5xgY1SrULqPPZ#zErs7Mil{Ipiw3XHYVp54h>r1W*o~DiQ
zqL*TX5lpN<%vIpedVOTTGAc+JY=8O#^Oi4E8Vgabrf{#ku%w^u?-f$B1%Fj(-ZAvt
zz3+&1qN`OP$48T@G2r2b&mdpqDx27fb<^@A?+m&(Ila_%k`Ls^6DBUWM})Vxl!2_D
zX_TnDHh;ahlaJ(68pILat^b*3@OD)j@jG9edR%C@+8%@`kxB@x>e<{8de5XF$HJa?
z@!%B2Z_!#aA#Yr_AQW7$3?jOb`s{e$r&0ny8+GTm;HPRFH6G!hZvCbIs)x2poqrYe
z;Mn_FQ4Xf%OwO+LsKNC)bK;v)x->F(KS=@jAW<=^M^k!Vn@@kx+<Uv%pGFUDWMXf}
zZci*Mw02X)wkVc9O<<B0mRe)uVu<YxSh&`gRTLSL2>``*10N}ej>c!qxCFdWrgN8N
zx!WKx5OH2U8_(a4y-EzQxu|$Gxjf5x^41u~C;GD<7Fc=g_6hLn*ZYO2aDhP5aG5a%
zh?j)vf`q^Wh`>u4my066-rXNx0#&j%9-I|syiWZsM#6qPji?sVaTy){{_E#8Q&$Q_
zx&TE1JsOjol*akbSKjVshB*M=i~bNU?<IZ*9#ZMc%;^BIt}8EwO^zi)FvFh;MOwA`
z9z5$I4+v&Xo^&(H9b;V5=4>PEV?RC<GkkbT&HKSw#U_30SE%cu*V3JJJ<nm~tB@m#
z@M@a4jWrYtItE#%)~%t0jY}l3I0RJzK0wy)nx|lqQQOFUOCmhJWsxqZk!o)*^WQ!P
zS-tuw@c{%K2C|n263acRyLdUE1Qewv<U^PNr$(?*FPwu{KEsY1Fe>sLd0pOkam(1&
zpL`_k@R5~sE2pXSK1k=^>o{H$)J;I{x;d;ef~m;p1UTL_(4<DA$%eY)ShNzi`{q5r
z@d0{O-uy%yWmLRnYxANFzJ5Hr7KXANE|pv_1O(i73L?BXANzUU#9Kr@0iqtfrSM0+
zBT1<>II*n5!8Q5E`Fr}`+Z%MbB(Q;E&LBSIuOfTIL#T$v+npkuSBsCG8`q@vDT<4x
zM>^+XVoOhe*|Ob=zXe`uudb8<>lk1v{d5!5MlwUXg2K-;BUplJ((@Bm$+*_VDf5^g
zAv|!#IQCR-Pj`3RpF<YUD@N~InR`hUNzi2pY+}ZYYf}_o9>er-@&fgMtPLNDB>&b0
zI21TNSNr9Zu4%S7d|vPQYhxrh_n&g;kch8{r$1t2k;)lb;MZ0gC&vQFscM3v)EF*!
zP-y3=`e8XG_j67Gx0Teoql0tl_ftMDFiS{>+a^v<kk<|BQJv@3$3I?FQ;8j@QWF^p
zCC<3ls+H$W{jmI*W*N|r6F6gyUd`g(1!I5)|DA26BXj#^!|FmKRH4fo=oK}#H*jEX
zbjCD1|2N#mUD9T%$a@1i+7>Tb-^RdvlVHAP+?pkTABSf*xb4*?wl7t;*lH0gE!bAy
z3Z6AW?_)v#f<5zgK*P=P-`{sqm86QW+aZzSgtWwxV1`Ys_Rn^TnBkP+l2Nm51`FI)
zX@sO}*qt(cJt_LqrBa#7@v(~v*y3A~GbOs!@UwC9y(7cEHcC6E^fzwMdNUEHe=X>&
zpGJ+opdyz$i`{&W0N-nHR}Zt#uX87Tb|n@Yq`agRjk)@ksh=__lPy`XT2>shZBqBS
zt`X%m>R0Ob$n%$ec;@}uIzo@Xx&$`B9Rfq{P2J8d>ZLbIe<bZFQk{&W!FGOu8L6%;
zv?4H$Cq3g{f{#j9fQY43oqENfhLD&KwjIg8%=MYk!vil49w|MH-ntS=pHeTRD5`V4
zOHby{Zu69=Li5*u0`$EE3B0FClP8b>h{5&}i$WAPj>wkY*2gc34Sf5~!DwmlHD|7&
zl*L)-`OZFS0XQrVU;@v#7~6=q&4iv;FZ4ebT6_^T5}e1>&g>!zO+LpY4bZmAtd<3k
zN6ZPo_I>slkdvgKa)Cr1n70KFOn5T|pes=^v0<<Cxr-Z=-OKoVDj=<<yU4MDdhEO$
z7x__GnP@Q?PRd9~WkYo^8up-9Xf(~w)8c_LZ=gJnw_ghn?X-^r(@wT*oK0)QU}I8F
zFlojgpG@h$0T=xdXO+JxT=Y!$e!TH1=;8g6s^igl)AXE$`tDADCFlFEE<CPbjJf;E
zs;Y|iX^$R*GNGTEph_xxF-gm<tm^&Alr9oEDuCa>EoDDa{EcOtp}U+U+|v61rI0(R
ztiICgDZy8m)Oc$+t>LA#Wb4qcg@?bMu>3}D?M_Q-iW7JB9ihq3tE<iGx>S837ar=h
z{lIsjR5zl}%YD$H$1NT^1*9401GpVsIZgDDzvC&%-`OQM0ry6Cmc@yS_YBu}_EkJD
znwD);JaU0*NVij8VIEWYA1uD`bjv_{>Ves!gs+K0{M~@u*l{ARUn+kmoXWYOMZ>k!
zapvEa1;W(ZAIjx%0bheZNR9)zkHQ7SYmODaKh_^-)$(N>po*8L56_0F;F*5?AT|IR
zSIN5lje@lCc+2njNts&Nm&%HN_o=XO8h5TQDFyr-W#*7~IVola$i=ndRYe<?O4h9R
zA9dnb0h}11P5yhuwbk_VO|ePYi7+Uz|B&)1!*vDBu~J_A5N1-V>sE$JR*gvhHw{*<
zuqyXq8j!23s0^c(qScAXD$TgC+w(*TuSJLK$hcfFb`XGgRVrZ5q@+AZp&nH<-SM(^
z{D<o$b@xVa(OU+4Z&4v9q1gCVyYva547p9p@fkb}oKtoyQAGb{;RPe=XG!s=3LA!c
z4SA-eEzY5Ebj)o&ol)y`TW3D<{JAnUTAl(3$iV0ON9^jl#45S?tB6NtL575}IVBM>
z{rzlGNPa$Yzw?!6L(%HmOy}@1@8S~7w+Q}dn+(=;C*CkVqbiJbBu=FgI~sU<Vhm;A
z7|}MEah43ejVt_n#(R_FZgPKJr2HYNT+qcDjT2|Zbu&v}Wo^!_t6v>u{6kKAji4<w
zgUW4>r7ouK?<O-BrZHnZlOc@mVd5TYZJF(4ErCNHvxLaXY(3h5z!8UTH@d&r%hCK0
zTmN}G^$@S4cLgIfRB8+P*-wB5gKoS>O8*n>v-h8WG>tcyM6gxD2K9XVw^`kP!#Art
zXxAhs%Sx65tLellK_))#_lW&WY)-KXNlptBr~P`VH92Sb?{~JFO)oIvdEq{r9ohyv
z)7SO|<MEdIA{cbtclP&>K07ibD%r|SulyNp?HhbIo&aBxex6V>u>KE{uEMX$_UjK&
zP(hGV5C$kHN{4hKjdVBC-CZN3yTbt@9b?kn-QCUTk%Q6WdH4Ig|G|B4_jRswzIATf
ziBUD2)$Xp7#_roq=O@-2BX0nfd^kb(pxp5e@q(06x(8}z)r-pIQ(w<+XoPcMS~~G&
zP_WPgmC}5B%z071aAP@DuH&a6*hdoPpn+n!+lrZ&TskF?i9)nW;NRnAYSNLNO%{Gb
z(Vyn_X%_oUOMpPHI`Ls{f3Eej@>f4D*dm%VOxOq}pGaZjsk-=c#0CmhurDU1rBhi+
zZMFV(XdeCRg^VQOxkI$u%8n`vH({#Lg~)WfjfBharg8PT>)kc9ZO~~$tE*IK7kWp{
z^LyT%vCOu3&w52SBXRd@6EV&yjJC-6$-8teM1pLfCA+hOmpTafWYI=nQRxH?A}!Qv
z28UZ{P-4oA<J<xSu8R$}RqF?FhTjQjEl@sOkrt)PSH&)CiD#J9*1c}b_ur*$_`U$w
zYW-BSdfTG^)+rCfe%_~*IH4*);OJ8#xA6Pm$9x(6;s${rvE|n5_n#8Ql8q-uhWH@=
z8s4X#B|5<Wp{|dGLj61#8tTd!;!P)id7HRr8Kh{kV^A8i!4v19<QhR61I}k-UUhW4
zpGULoS8q{kjZ(^mV!$f+xPaQTYR*j=@tysUKHo9zd$M)8UE9E}S#sP>he6=Q%tjI8
zTmZ$WUnmXU8xENXht$4!&%f?diq};q{Gy{aV*R4RbAJY$=y-67ca2!hM}MlcTWHJz
z`|>GGdAs`A$Gi#RbGX8!tb(4);Gky@!<SEYbZ*M>iM12Ya<=r;6IIyqX}F!isDO^)
z`eTPzf4YMQLgLUf9t-0!<L7BU>w~32470m>A}K!lVj%`skE2i-<zJ_rCr_Y4=cUh%
zpV#}!Wiu%OCHu)q?8y_98jBXR`^M_YX|#DI<sKEm6fNl{;D}UZ@Eb80TJL|RD~vN)
z>1PQupzqNf+%#DGE3-JLzEkyxZJYI&o^G~OXcLwFRpClYNaXs@EG@CFm9C#0a|Nl1
zSTH~X3j;La2=Ov=+^hDsq`|mk{eI_urfqJIQjta4?RU*M_sl3&723Xkiz$sU3nrXu
zlWrQ5`ItT9X4JwM!@@g&ldG09H+kaAS><lk@g{jVR!3KK^X-mVG77c=T_bI9BoV_f
zMTC*vN#O_q@(z*}Hx`h08L~}ivd1Vf{{vfff6ZGRlDF!{1V46i7N1gv=<BmI!j&S;
zBn2{~1C9ydD46QXnh5-Uao2gl=m_2P?u6#t3vqLK`z`IQHJNIRxB=NGwYZnp_VRq@
zeSchzIs;o(lKv!v*{Qv*AXZXpK7Jh&_eYkW$coll?{&~@mS_9xTYbkfsr+q|34xEb
z+(#~dOldu5;ux1|OYH5g`roZ<`&tlwv-!iqp5VmqjQYAzUKZnFG&hks%E*tXMl=-l
zNR_)KF<HHg$S$n8Nq&G_A<GHeZQwiB67nv^FFJQ=?O=Gm7uss^OQ40^wL2<zZDiaU
zXyocUZH<%PnC7mf{YpJX1kCP=cJh8f>{(+VW6*BSdTOmftsa{CAM)h0T{=pC#5f(I
zz5Agkvqt%AbAJY|*5#$XO9E`dBOt$lkgiAHpFBy^<rn56SN$5M=mv-Pq(!>(KY@Dc
z<gxTu8Hu)8xHnz2eeX4!xdOrk6b0hAr@nBaEw5W<crIR7<sO$|KQIum=OD-@Pg6b!
z7d0WfK%?_+A|i2C<AJd*vL}HeZXlSUR*K^$nfE`yvOp*MqvEX?)GOf2vvg)ViyGrU
zshPs&{XQ=2M&MlBy|nQw9fSUhG2D~{su#viViSs~J}6yh|B2eoqoICvpJGtQ6WP6p
zs5>{>PeD#bi!)t61^BT~V@eZs=My*Gbd$7}H`+%6+{dBYZ?_$J`p`^AlxN=(zYdh9
z{|`{XSpEuybP*n{@Jocfd~;NTm)#Occ6c`5R34qsmqg<l63idRuXS+sj*B;cr;1Y<
z{98B~l?F0{zI#-fgFGs2zc~E{eVrdp#BrRqD{Tf0e~^y<v2frRj=pPeiH1c8yrd;V
zcNzesF?cLES`PcGmxlQE2K?*&X(*+PK3JIvRQ~sB+*8MVP6w_3Hwu&wAyplvi|Av9
zOgD;e=P6aIAB1;>^6hc8mN%)A-EFMT!V1BC<K%3pznS6<%z_8BjlU<m+p>`={Jg-}
ze1hW2yPbi_+gptEzn@RvW((Lb_2sHvnHU9<LAPeOH0P)+Wl~s3%)@CtoQL+?{3qzF
zXXFHQsFll677qFF(m$F!;NCcOwxQKF-u;hRmTZiAC%<Ag`F-y_X(<r`^X&X|E1G7C
z$`Sy3Xkd9zu=my37<0^*UqeixFYOY8l>$17_p>~wcf3i!Yx+lw)?}}n>Ys~>iENF7
zXpJ=e@NW&Q^Q@<iZZtzbB`{|9B*OKZLLGmGTRV&tQ+coDlzN@GjM%>ze}Nmc-29qC
zCTg6f7trfKcLPJ?(?%4UhU3|B!`0Q*%ryW27S_!A-`8QQ`B;3su=vZUZ69VC>7n4~
zTFW~B*t}5ELISR815|n}Ue98{&WFowL&Kx@U!)!q*2M?**pmuEft~vhAD*7;pCndd
z0D!z@(22hGJSv*MR8s#M@>>3ns8+}T*T2C6CmbMJbjk-!cbOkx*0Qd(w2?E7#-Y3-
zgB$W(;PEW&spBRQ(748UTvv_~w`rJ`g{Dwg1}VL-gI5oQfbD4Wt{^CK>JijYoY)|x
z@qIw*wT8jAv($|z&&QYoQ`caRi!S(dA^WK$tmDUi?q#3%sir6YbbH8@p3gsesNiK*
z3+A_wuR#kju&i;_<|-Qo7SwCBXG}DnMr9HllWXXsRrxgR^ImCt%(V9gPx{&*Q=M_L
zHJt1*M2m_+zfmp;!CNEC6<(6Grgt`p#`&!b48K?4T8Oj|0n39fU6WilW`NB;3n@!Y
znB1#m`yVjK288FlP2_PXfN$hTHq%XY=Vk0~)(vIYluJ!SSCCgHXKLC%W<=9pRht*|
zisErrqJJJYP^{fdTG2_##>D+o%WsdjQarLO7Lqilv0A5J2aylGYNvIi;wC|@v18!G
zOuGHp{01LQjZY4_xsM{7aUQFl=nl6z8W?+WC2l)p)-W?0W)<SHe!7v4HC+j^>H#)#
zJ4=(c>PK>)P@fa7r%GR&HW=}s?99p55omrMl^A-Rt*6t(?-6gOtFvMY*!RHkp#4LY
z4PR)*JwKWd4`P}6)i91F*y{$I^M7vp$nW9XF>;TNV&SMPl}_|S7k`n-6N@>>alw)a
zhJP+QR`%La_P?fv^b=0~J7;<D*WDeV6jmpYTpx=g`fbrFD!xqwLaYeQTitkPS;e|_
zGiJPwt&PHxh)oYbi!V^&x@o*SwTUz{A1Gv(yRflXO>=rRgsp`&I*_-N4pW+rYiDaW
z=z{g#g;#BaNa|=>rYSZa<6`k)M)L&o4$JL(Vz9U7(_i%DxPmU+gPYbvwfDp$CCmNo
z8dJT6-$_)mdmcuj+}<wSRFN0_#Qb;1cbDnh@BiASZsUpieq$<APB7|h7X{MI7oYuZ
z*A&de9bku$y(xvTnr1I)MUw1W!_JGx*D5=pa0FYbz*-buMc-W1;7dWb(vLc=8(fX_
zVPw}wUrRRhG878)>^rqEb~T=v1^eEsP>4}UIB3IY;+%CWjnuL?iXxV(W@&w0?VT^N
z^%1-xPtCW<*Gab$xdZ`pT`+}L8xE<^AAWN&l+wa{^uUOr`@P?`X)323v`br28=9l}
z?`msND&<>zAw6U+MZy(-T+u*GWi}~>2|k-^l5j`1U!6s*h-z;C@psqyFH1dJt}!Qr
zhlbJ@+(_Cm2}=#oz11StJ?Or?7{`*!#Hi=9Ur=ebQm^m_TW0Qc`SR$@`u;@eG!sPt
zfZ#IgLF?KI6=7fd;A<3NM80X1^3r(5LWCiZmt!A24p}yU<WRW85pg)L3U2Dd_sQ$O
zKIn*3G~^-8>&yMOpBvzGUNDCxVnvv@Xso1So%V}BZH{Z(Xcf+pCBgF_aw>XvYCKJR
zlFy77E3^dLzXnLh>U`1t<>LrPYy29QtKvRRd<F>d@72{R$gG_oY3Q5c*}QjP+Dm!&
z^-kcy-OFR62UKg(@#&v-e=*+sAY~`4>Qs?TanSp7xKO^scS{e~?2hU7^<UXPnCKp8
z535hCCGS`V+vxs?>IsMjXcH!32og;0Q_q)%OQJ6G1f9qdLxRwfA=TD+HRpeW4j5Sq
ziLr~4&tlvs5F!wx%xSuz^go+{fJYPom%X7ZVOeYDkr74!u)U+SvfSCBpM)mZHJs)g
zE&mXK_$$$=9A1x@JN$Xp&(`?Zk?MEqs+Ut%)C~0U`cj^D<u76evd(aDy)>I|%oKaY
z8TTJxpX;)2e~cM-cW>5~7uX3zyNK9=2hedWn#?UkY0bGTbkB@g=_jc#;c72Z`rqIo
z*w|NcCrY6jL&xz&F`CC=s>9r6iH(>z;=Y!T4-1}~M6XKd5?;`u9r^zOJ~mz?p=S2@
zOQrRCuVddlkJT7(XoK5&d?y0HI=C*A^egw#^`N>a|J^Ar5!piQqm0Ch-mf&QPMlGP
zorfyuBlW$Uz(F%}v!);7{V{dZe+zzV(%^;^qb3*zvki6LK&wjWhhs?WmZe&)sV>lU
zJ7;OHSSF+tuLodeTExC_(dRV$<0x)*RGU)ztEwVr4E4S)yM)-XqAX3$Mz%TqYTL_7
z(YK@W*kn6|{hSNS?a8S0tK8$WF#h&B1`d$55r5jiV@;$_$m(u9%+SN+BqaG#Iuk6c
zFVs@oLGctG_Gma~q&-{UG4iR#Ui(hih?chaZlDwvTH9i2GF43X{8gJPx_pItY<`4=
zMF|w-Kl^J~^G~`_FI!curot)V)hQg^C_i!4S$kuyLaKvkQ+p)zFok`pPW05%xl-hu
zcNEdo)n=OJo_u*c!<42G<A)-Lx10z0l;|5sJ9ze`#1T0U+q$-c$2Iu@Z{gc5YB*Z@
zz(G%C34%Y72QanXhvl|G#F;zMU+EUfWw5{PN7*`7q9exq1LwqNmc;tTBw|M*3?J|<
zJ^$*~<S3}MBzGWD`bbthtM`__>>K(eCWo=~WnlaCLejUIqs^;-t&Xo?d&`Y?<Wgkd
zo2v>6cXJSY@}jJ7&cSsB{f~z+mrGnqzXcN^P-Jg2T=7hyydv!I>3X*d%6G4sFEcG&
z(|(gL`r|ar%y89AkAVyWIu_i#Q;D5xHV_6Kqto07L((W6!HPiB5AFW}0=~|BPSMyZ
z$G*Tp+i>4*I=4JZQg$pLZ>jv+9tx|erc*qW@o^n#cyLgKLh<Bf$w!wPwP{&4cLh$D
zi3m#|Xajhm%j|}JCEH62=c3<xzG$TQ>hjyS653#LAiZ}bX0WbGn&trSHAEg4fz|gB
z*h9_Yn*)3N`gy(F0X?adhFX=%X|2}Lmh&tp85H0F^Jy<gX?x|FD!7G(HK|7qb(e$`
zWd(G%*A2z2%@#b9>0XoBB{^{j1f(YB+uj#7m(fw1)W!ZQ3?dp7pmw-o+|WAuGOhT#
z<lY{A#lN0i4}L>``Enz*lgUL=v4(B=sPUCI5CfuGUA+iPQdo=AyOMfEFzPk&Lj`K3
zOAuS@Ipq%LJ*7!74#WDgmO<5D7lMYk4DfQfzA_|uSg#2W1bG#29sdU);L5Xiq*W?f
z-B}q9Ku3|8J#3d(#J=Aa3)G^_NkxzyAhewI-0pI#%opo2etzAiIzhuEpvdp)ZE?KS
zy)d9qvle*OkN#r6Z%p}cowCXbqJ5HeYL1%52V0g76#9@$@Eu)_n3vPD_4QzcrRv7d
zjNWwo`VUYO-a`<SDDA_frgQO@lX<n1Cv81n#LXQo%U>w`oLlBqukyM6NfX@I`|1S&
z@*3*W{sCt5AnV7z_*ki-mkbq&JlSze#ARk#W47DUP7KihGJq&s(5ig+EAEZ<dkHwW
zxLB}@>*zfW{`#lv3*K2!D++qC7L-ap{&i%_E-R~r6VY>x>Ihdw6>y1BHofKMPMba<
zU+&X6cRt>3Wti69{vfx*3kVc&JBfP0`}9<-;7u(Z7=6udD31^~Tu%2k<7I42_-;lW
z(4p_|UsmBP2&I(&$Pp6!VrZbaO}A}AR+jfb|0M}Kxx{ao=ZJS5XdX#WJ%DhAi}l@Y
z4v>EdmsW)LS)h=AS!tao&!n2d@|TC2PO7){=b$ji@m8#7M3)6pWV*qQIqP~yfkps>
zcbxx;^ujAE&NWqP;=3g9b^l^wAhrPVM7cGPh-@=4dCXh4UT(QZCun#x226EV#1s=F
zW-PWzxTv=A=aZS=yy7(Z0)31z4E%sTeQ-5-Y`RLc1Lnyn9Bvq0<3lY=GV8!CiMo(7
z#AV?Ve9-#i^^tc0Ks-1ggkTJ(W?fqXX1M1&R>7CQDgNPB9QD|IzY+G4b|jc{HtX&v
zi#wjBMNxu3w4GW17fs^qHT2zW!VhP;hh|LnsKc&9%`qUa)UsuuO!&zuw<QND{fbbZ
z<5E#)@ogMhF4)iJe7CTq_*gRhgiNfcTsPL?J4xXCpWCw7fg-iXm_>;)WI%T-J#h*c
zHV~E|lR=mBhYAb|wbFb0g$$g;;Ua~OkW|y0dvEvzr<pwiGz^*WP}&~>gy8VA=Z81K
zWT@P40%SU{oTIhMMZSUig|)5|#AdwDWsM%wH&d4C$9Vd0*3HVG@s7`a`!E5Szw+s?
zTv}@gM+nret^|>v8xM@%P>Pe}l;l?maXyZDZWfM7(#~ezHT?qBzf3ht=~YkMbJxJR
zRR;O4*FxxhZJqutS?KWfKQ%tlJ1!s~yQF66Xss*0mIM6$sg|4B0CLjX5EI9FldvWB
zbQHH&$n$O?ob4{{dc{fhVO*%~xurS1XBG339&`)!!EKG|vX=+DdxcPvY&7Z1ow|>2
z^2ENuQ;50sRwI#s8z$`~8fzG6bTpOp=9Nx$U%iCux;UY6;`_9{7T;W9spR46@0qxi
zFYfx4;40cfpB@o<hb+d^xwuT#tYc1MN8z`UKi;N;&|nKC7f}PN<lW(a0DN~{3F{&T
zF>|s9mem&G(EzjqZY^n#(d@N@rUxCH>oBiyPRD*5SBo9OnI|Rb4BZ5$(xxG{qQrkh
z{i;%3GR8RS*gDbu3sZP2>vluKtG2sJiI+I1?ZM?Rg;sYp7;&amP$dR0K#_YL#2n*@
zeM9LuQTt<!XiS`OB|o39pKF=+<)0&%{=6i=lXD|jp}GE+ePVfueCoi^C?;!A5E9|m
zOFH6}%~=-50I&~?hNJSHB>7m2W#6tVf6Pwd_)(5%8o*3yKXZg%D4pL?j%Tf%-Q9r_
zeWnj3h`9d>=CVe<I6(8Fx@iP&4<G0ng85k96aOPMN?(A=&2v#2BrTltnTNSoZlmUA
zN16kV#z^-giWUinf=Ov@&SeIlK5x#awjFyLv0%I7h7QA?y?3^6kuF}9)bK)_kXDrg
zN8{<!%CvC7)Q1ZGqWRt|E}i}uRO`sfQUkEuE5$*jI!TVl9_xM?TD0UhQAM&`@Kd_;
z8u`$G^AiYSl`}f7yhbYMis=>Koh*$<acV!jDp6cQOHQ2z;=g#17Z|hAsGG50w$3pA
zLir?|y1A!qJ=ZJw9r`G8<iCKsohOf_qTwU9v9s`q?fLZnR_mwT)DabX4qvW7(vpjo
zaK_oh7P4~OUVNLk|9AcpGZ<hx6pk^7g+=F-kG!rN{GRkGROI&=DgY-a6Si({v@9<p
zy=7GX)EceH|I8`1c{bPY*Qs`pfI19XD!iXtXeA#2Ky3ZMNMN6CK86g|3(7XA>W@O&
zb*SmKTBwx@1*J-sp6$dWSyAT|noQYavhl+f->*hWSc8N5mA;kn432wSO$<;k;~M@4
z_|*b~#voyQh{E~Lv1AB23BRf?;YfY;M2A;f|6BmP2SO<CGb6_r2<718^c{aGQkQZM
z#x+IS*nBtB5j^n4;l_NXEnb*JV%X?@Op^14a4L{O=y|nNjE~>K@W;3xjCiIA{617|
z@B@*hv#r>o%y-wjbN?=R$!Y6cOl=-01>{R-q+Y4+3n9FJ?1&KxI=#3;azV{s)JKYu
z(V1dBGQt=dMoj<yl^ZF!!zKyz!hup!*?eq?<3U573!F2iT=l;kI;#eEC^7%$n+A)L
zABaBs%;~}+FMWxUB3AIc`bAQu>3%icdBln0;h>2(B-cS>u1roA{u)J-0D{L72a5hE
zTQ;6^gvSyp$^uMUAI<!G%D_#grc1S-h@|rA1MxX{57(Q?@|Az(@D6rCfB*IyNHusE
zBSm6LHoam;fGt|(x4&acEB}e%3=nFpY$bO1YX|RwP#}f<8eLI;wsdO1=K_}o&+`TI
z-pc}`zTl>v9Oibn4;S94fK^rPvy`ipgH`&`pF{E8lX^iCc27TNPNx=a4L|enhH(to
zTh7UO6^V{^Y{A}(Eby}|;*7r>lUQCXXfT(LSVmk=uco1{$}n)~lcOHseb;Q-ULeIu
z$QqG=yj6mu2tygoUHm^9=Z&a~njx3zf?U`BF}>?6b@$ucHPby2GV2KsUF`^F#+r6z
zZfp*M+5I3SR4`X2X_Apd$IN}0A-D0R$k&_73R1H_`RF>*E?o`tB84nXJ90<^Ma88=
zCw{`C+Hkd{s+Oug%3`?7tT1`+<l0<)-u3<D+{b9p@*eJpH(ih<S4m68So0$M(MN6A
z(B`J+$INhH4Yx%)wX-Y|+4qAe?SU13!2!M__E$XW?;eq;iW1O9hmiz05sbp<&TfkJ
z71Qfky`A<bcmXETE{XuECa##3-!9VGzQUdzM{1F*$O08-g5=`vTbY@&k;4vZFT8-d
z$z_FW?f0JI^;7Zd1999J!w>VZ{<%l{LWUX?tVesnN3u?EYqPwHVv&}+2<DtoU(=aG
zJxzYUdaL&mpQJ}W(377b?%zAtv<MFW2WW{cY<Wa;c?Oa0uMPXZ5g#J{HOHQtP<w~p
z$eba|u9sa#ycXWCnmqq~6ZyhUii}|UMx^jZmVDO6!XsABn^a!g3!&Ee{{ZLxzX#2e
zM>G+`09DC57omYdnM(nJYQ>;W0T`5w@s4sSCx4$>NA;P}S`x&^ES;YT@??WCXlF{#
zL-Bkq6D!lq=k1S2FMhs!xX8WsFV{9?`5&ieFARG>xgR>SaKCVWpp&`R5t^B9M+6{~
z;&X&ZQuJBloW`Hdb>ErugF@9@mOw_V@H0NUcIsOfM2~Gr#@e=q->Is17geeSA0nP4
z5PJaK((|v`W%1JcB7{S2+w@E@KP`_0e)@?3gJ?DE&vZ{sPG9kockxl{%Ig^X56wYN
zuBq-6k9I(BO=OW6B)P42_7nqrtJ!dFn1P<{oOVQF#IER3@gt+e+6kJGC1()a|6VNV
zP9lE418Hjycq}GY6=JY|tH9l@lQ-$MMZst3TNM97_G&_R7pgL@U;7_mt79|j-A+>5
z-xH948>^nxnJ=gQ2yK{qkBr{)a3>+0Y3ShfvJKtaO*1eazHA{`2_y5Uxyl$~LyT%`
z6%mlXoEMw9YESP#Ah)3LmqWhPhO#U$pKrouxMS`F)@mU1iQ+Phb|LNy7?S5!+8n!h
zz(glT#J~m%_CH(~zHpBZetcc&^%vRQS7d#upXB3LB10Y7S;)PtVxY_Bwz`wQ@%@4e
z$v7sh+B$2Q*a|NX&r(bB6ks<+?$;SKBxxp?2}Y4*+*tDMCrGi!EUc;D_|Hw=53A@m
z_{%LgT*|1IMkJ=uC9%ih>_7R;m25|v$Y(0PqYatKLGkWiRjkMAFB8b;PX&;8*$Zlb
z-bBr_zuh(A@NbUsd`d-DrWWfR_^4|pNWHT$eFcCL@RwVZ=6B!%S*#B|y2UNr>2kc`
zy2k(tOoULp&0X0zLiX22tHdVBxUgX_6{kw531<TzFrNOAfkz^See*4r;Qq%1DW}oS
z9Bll6l=@lUT#i2&seaYK2tZ=o)m#Fvs*7_F7{Df+8|$N2o-6&=CrT+pyezj_7Fd;g
zUilxO(+cu2g|BNRc>?XSZ)7iR{&7%TthVxvOs=<N;29p3&-{To&2GGy5!*uRsdwE*
zTb`D30)>m1z&|H~&#gw=?1U?FBzVU0=vWgZya7ACUN+lHuSDkV$^Y+d4K^Sd+#t76
zC;D;J3<k!tB%2_;=F-@X**<-YeXbD+NR;8*B<z~7AtC*w=&?hXQ`bKuEtk$oh+#*=
z+b>NYRhvW@`D*jaKHa&H4RH9-csc?^Vl}8i;eJJHONn(E_u7B|;=SXBVvvRedzi%$
zG1=Y3%)e9DLqjTm_xDB%uDzqGX$(n-^nK#)x;5b;!>`71n>5|kG908YhEn4#=r*zR
z@tX={>Nm`5ac=OO<WAfb)|8rt3d2gSlqAuYd_#CkeCter(OmNrJ&wPV+e2O0^Np&E
zAzJ^zl=FbP!a`J<YPyZOMB`_%m{I4)^7R&FRe7hZmO3=Zdi#9P-ksS|)9QGaU60lw
zGyDsOZ}Kd%@{~gU_2(&?nsD|n*rND4D<Zykv+C(g>Tl0nvx;h}m)<&@ZpIB8$la@v
zu$8cvkg?L=hyvqmKaa7rsyGA35dJyCOk~V2@4mayZtzZgOWIXbIB9?)?<qkfwTCFq
zGBx1e;*7<hFaTgj&4D&uOAOCJm3Q^**=7uNo7%ISA`XvS&LyJnuK3`ok>U@{ntU0g
z!=%?D^YsM_4#A%@9Y&le<3Fl8?_A#KqdVJrNcqZr$K7L`+-zHIN+C+`aXzdvv#6(-
z^C-YN?MUo09q`7#W5OrPw#x4ZOOTfcy^GDKGlBdl*>U}|;vG6I0`nJ9TevIn&6|&d
z{GLY)wqp`xTI_dK#0a?;cZ&S)<=3oP;e+A$-d{ml{{ezE<;(kiyZ5u00=VbMjM*1&
z?$ur+3nQhiM_0h4F)l}(aC8fPR9rrV)})A320Lllh@5XMn2J-tR|@bds-BN)yj+Fx
z?$1O`)wTwItQwZfk1clI4Jh8onq$#&D1NQ$sb7Vzfhhf&y;yFAo{Yu)XNX*sL!IG`
zG7pxs9f0R64#c)ToX)tIOW8hkRm(YJg-J>x@eTSaU$1t5Eyv7n@^6QOfSc(C>ulhv
z>zRh!bu~Jg;Yn(;s4YL_siQzAY(@QovP!o2Pu!Xk4?bIq5)Qo2;gH`U_HS><k6%YT
zHm|s5^S|VZY0pANPQQEJQX)OBZOuFG-beo(DU;tf8lE9F?#c*^@JFYJGU|S?w~?{q
z#2D(wDSXLbvj&3pZiCm9-0dQMYcchy$aHm{oXL`Jd`N5{j#JQA)2*SWu!?k&FG~>Z
zmy)*0dC?_^|FU1S{KK*3ZMt5(*o;{d%QHwy1l37Q@~u|JVe-btM%}qfLOHpi4*r}5
zP|=@V|I)g_Ki-nHC|^p$tYHc$9Tq^-2Q{KlU?*5S$@r2P&H+Yji2G<I1#E1PY@iju
zxD|f5rmocweQMZF6wmE{GK~EP@aLX78*|&tV^}P6@;^gJxpp&<MRc9DAkhbd^Rj=s
zpYLSeYsFXK<O{aqwvt0D41TW>xIIZ1)XjnEVLw3&KQprBIio6|uuZ8n%hLJWoM47z
zQk17eLLl#CS{J4^?Mn8kSx$Z3?g@rd>~>bZ)&2b&UlxFU`%>`hUumIUqgE%f9g8+@
zE}jPCKp8_2f!rOQzma`pN()sXZ<*Vv13Fmgoi%{UyU-G^PdPW`95itS{ix;A6r-h5
z&A#|*lhTFYvIL<eprn-QA~0?Hm-HSJ%4Z@35V8)e(iA(4!LNJYhTR}+l=xi&Qgws<
zp$VSY)hFJf!$U*y&&hRQQmfpeRyf{Y_Jf5bhNopB_!@YbdjXX@r*kCwu&70Ll4Bc9
zHES)9t#0bNRI3s(i+#kOJZ9$?X!f;>cPF6k5~wTKygarTd?ywZw)%#j3XPB;(a5f>
zsJ%|`<zOdYWyRaNWd8HYNy~}!SK+FOJR##-K_OlJ&mEVZcm9Y8rTtWc7I{LAthKfz
zq&=cn>H`TB!IuL@Mi823lxeRpHi<jY7=jk@Y22^ce^q1|Z#M=HgJ!o2ta-u_i(dxN
zqBg3IREy~*xx@EHco6)W3$5;DTZfMZns{ZEij$kUyG9OPZJ*m`>Ag|`9;{>*otvl|
z;l)kg07INN!!re~9q6-6fDqJoRq5?(k9=Z%!p^ZwwSBXix!z^|ncSSH#5FWKuty+w
z3kwi*bzS-K9ygO2O5-*6ol%xLW6@%V_=CvW004w6r{s*$%w0e>jEo}B5eioAX9M>q
zrlUv&py`(xYIaIXYdZ&lh>019e8FOS18vu{c(iN#M-A%-AHVYWfkJ;Ky5eW(F0Etp
zz0#_E+k{kYebv;}K`orr=&L$FbO_|)n^n%WqwCDWALiFEB1TkcutK&HFK+uSTh;){
ztG5$<dWPaijV;`WD305^w*ULd#8l)6rYe29u<&QEIW&@alT#v^LX@qHcOB;r^>xlx
zh9%6yX)^dmIaXcY@E_{fSCtZh&W{B)0s~SV`W!3&N_(@DC{ELvnP+pSE)R65f~X4#
zb^pIHYnsqt(Q}im3UF9?5KszD`-H`bkw`|56oKj1Cv+7ox4w8bkNCNR&(X6X^wcpN
zwlUi8ysIBw`Sc_4Gq~@%FH4r0G-}6X(C6u6g&};t)UKk3n1+L?tk@Q+)N}a6RbVZb
zzgyJs)Il(~3wE@xT}>k2ZKgoy)pfE-+F>f)^${EDS$}^sXnv{v(thD};^5F#zb${t
zu42HDgGG}W1c(kfwKq~}Y)KMGe|Vk$hBgLVMHS;~+0HOm%UvaRA^Mh!sV}krIC&QP
zl*76x&uid+&J;_o@vG$xP^JZLx-8~Uof#e`8#N<Zu-p^nH&apLod`To`>Ai7K(KZn
zqrp6femZF4?_fog2y{f*-o-LT0_6RECwyQOovTEsz;nJL*RF>}(uyB&)^VsS`K<#A
zAM93F_n%w1{JLUz#A)yw$UwmF)%8MVGY|OkB;*mE*Kq!nYcb-xjd5KL=?bmp*1&%;
zLbc|5uL{wb)YMzKf5c;05|DhDIOkzL;Q}g4%}_IpVef{0S|OVtLpq4OTB;9`pQ%R&
zTJZ-G{6v4N+OpGHX;8F@W;4eg<a^_G4g6dK9Q^4RgTLvl9O}KOz#<Qj8QOex5LTWE
zUafpj)MICGlj9`BfDl)a1^6Jm$E<-WDY;@7{jvadx(gJ;u``p3#rMG0%YKI6vgF)n
zrUR`i5Z0(xi4l_G2mW3T#^hg}590wHBcu~H3mowIlOpTs-$F#fmZ@<)e88qBYR9KK
zSKVtzdvwy7yD;>%f?ABp(^$tjE8M8@sQs<=yywl-VKes+?g#mCoZ-bI3}|SFeLQu~
z1rBVz^m)wDJQY=}o39D}cd{W4YRBvhP^Y9X9~0$;gF*V9%e*~I=w$lQ=#d@vmf>1q
zkM{NOoo2r%Z836SOWqxC!R1WU%xq7?`1^-(Z2vfEkz%=fO(?x<*&!FpPIdP&ZG*<$
zZ*r_;@MSy*;w#;yge?py=^w*A4xw1Vd0vAO@}1WxD*d_3?WX28M<kq``m?G&YJQa=
z5I~223wh14+S_hQv$~4OztA(*!hN3;E0sd@jlBEI5FZX@+-uQk&Z<}Zi3tRE+f5Bx
zeEC2JUUmRc<Nn8t9U{sv`^EFgGe4Qh90-H4Ea{Bji^U{~@^;b-ZWr1+pZfJCrtqrz
zTqMV!9df!3Gat{MvG@kKA07EKUrjdH5^-|x9`I9N4(ML7J`ZCG5+myze@VJ$>WEHs
zko{6WVLTaVH4DHQ85g;qYb;1?bxxdFZ+B2U-H(m9T{65N|9cn5ZYXfURTwvH9Aaxv
z_r^)u=ctprjD8Z{U9dfM8G2m&po7?FktY(kTmkZ7HVX;9#pJ_4($mt0Jbi3m_SjX(
zg!|*R$Qb;VCp`ca!{vzvE97IU`mtqU)K6uwWNA5vd0;vnBi^YX;Kj!z%~v_vp8GMT
zbrx%xHvIYrPndFt7qD)IQ5Z@{6frol#&x6EX7wqf^QVqPY?Cp)t)lb=-*Ip&<r7c2
z!a()o2J+B#?^0Hel=}P$YLxa=oNoJr%6p`2bX0b=bQG~e{620fE}(8;<R{K=!C=kC
z^`ftVYL`vpi!hw(90J%`JV(m%|Ay71hY6!sC)BKP1SnasXTXOJTGCb+{daITdN_{z
zWb;Jj1f2_6TWif+J0{F5JpYNk!k7q$Z)k|VgFfrthhSMHN(pobtgDmzpQ$aViqk;%
zaNg0~^E2}-IrHC%(NXM^kl70jJDS${)7N90J&kKgyuq}C8Zd}^|1gV(;GLlwzpP|k
zt8$;6xOgtZ31!FvJym1bavYRS71D~$S2;uR6Vx0SleA$3*Ot0WUEHatTa8wlX`kIb
z^UQQ^V4B94L(=$|X3g7+E2zpqY8PysepSr4Ayz11RcnWOBkMj85h#3iKdHs@5C!VI
z`u4G{{=6?**6V;KR(5?L2Ax%}yB8jdZ1ZQKJD-n9Tq;#=;Q1kiCX<Lt$Ok$O4YYsI
z*EtkQpF(^0pr782r$LL6sDRJ*1M#h<1qw9$<~4t4N42#px8Nb*Cz5m{l3IxB%yG5g
zKN|>>NB7b=p9!|8py$0-je@*V`OU)P1b_WoV$aH@8KYZ#nDTUizp!r$A5bH4ek*k`
z2>gcN2U>RFGjeVjO?O@&iwcE(@co2pn+-I8G=bQ0&1HYC;^W&!PUZ*`h4MnJauryb
zQ5y@Yw5s1!RRd1bIzR{kdFpq!zS>Q3BT5VQ%ZGuu#K3}Fh2jMNGO1ZdnqaBfZ;=wp
z*cMi~9)Kg~6(m%c>}$URDQV&KUQNlLlxEM3J?@o0pU>r%1nH%JYpcmp_!x%1(1+oq
z3OeVsYVmBJMJa84fwEA1Z)>-GNy{UTRWw<EDN9iUcJ172{&%NglkDta*b$U1H=Acp
z-@XAoussmwpKMjhk0<srJYQdGd9zbF&mfHWcih7V*&sl#anY5|+3jmj?--R27fj`&
zW4$}m){5>nm?%a*Nx5dl@`xOvM2r%b4lhN^-~Qf;(4><z{WKDvnNBwD3lg^dQ+0mj
zW5>dh!RNj@IzaE?^5TD_Tjpz!HxCr;`H?|56S?KqJSchSW$lUCB<R87U~vpVbvghJ
z%H+;x^9iAIOPxD^kE1>6BZ^-I5+>##?U}nTW5C9i)6I6q`!1_0o0$BBNeY4hu?eA2
zRZjD0ZBJ6(!}+G%NUDzpta86)>cGrn!zNmk8Tmp=z(G2KN*j8*w4z2`!}(SdzX6z1
z^b_?IEk8>VejY#d?M-C$@9^)8`0c}t>E}=7u=vQVw$#|Mo&kqb^)7;uH^6q4c=&u}
zEGg@{`pRDvXz-!zn|~;esvZPHFmW|`A8t5zb+!cC)U4Y^DQfra7Dhvwo4S&=!WJie
z)A|BrDd1z$>c5qnUFjM)TBn=r(p}_<KvcFXgVU%JB>_<8rM3lpHrw(#cc)`BD_&sW
zjS{nB|0@8wh@zK}G^yi{rVM?qt{w+f%$Uo5G-)MNzT|Ra5HF^tI+c8Q9b0NZhfOXo
z@SK6)R5+(;9}4l0K9BF7ymjpPR~s2w5GzX`1Gao*933y?_cDJzd)&=p%{@Lo&(i{a
zOTH`yzYox;jw-=q2f%Q^ChbyC33rY3j-SxjCbUKlYdQZz#E{?vW!4a5=0=HwxiSV8
zeU2{-@_BOr?adeTnYPjb+;!sMkblg##>E~&FFdkd9!zyFy|j_4exuQh7lsxri413T
z(qazt(D0ok9!6a)m>#U(zq6-_)4{dJh+LJHyHdiA7-z%0GM!L6xm!q#_ly?O{aU6_
z@3S73XS$Yz%_~%Ht%&;-XK(Y>-TZ8J{Hu=s;hVgGak-lbF4zX~o4Sgo=U((dD`=ua
z4&DV_FFx=v-e_JZy)+oXDr5hZBRk=TzY**9-Xw^S7jR1Bv)#V__eLWoS+?cWMnXzc
z+IXZ>RY~mX8m`)}vAh1qp0Trw2K)qiYKEoVXS1(}1-5tUkzvv123X~Af9Z@d+ln0I
zz1LJ-1HLT(HUh%qq5$DPYM<9boj~r6r7N}J9vkWCq%BvYJf9uOeXs7?U<(F0uu#|W
zpKGz4x^2sr8EZEqw2>g}%I+>^*Jay!s6GC?2JJ>e@KRIi6xP)y58|d9eO;yk@J^(^
zn|Vegf-<Bfh-iiAcQKDOOB0c>lHb{@Ip3M!lv8EiJU)Wy^iLb)?;jnDZ(H(bM`%yJ
z@SxD@G_+9Fk+LJkU22v~jVjlK8S=OL3l1IFMbS42qbza4A#Gnhd-VlLrpy!Pu@L;o
zskTt=*GHtkzhYK$he2%%9Ob~H@II`q<mIW>@GFnLm(MDkVHEN0FHwxphyioV<>i=<
z39>-fRg`V<n_Bg$5k-c_K8lqtI>^tT4Bi#L6h4p>BFU&vKr9RbdS5nQ=qG6ZED%f^
z5C!q8$V#CHaQG?q8d@F#g^N$6?Vg50@=5VHrdiK@!01v7vCjWq)ESKZ;?3LNzQ#N-
z#RY43PMf2CCZFWn>f@T;e3`)gp@g3WBI`I0?KvIe;SuiT@R78sR!&TY)Sf~7XEr$B
zqplC9b=8t@Ov{mick*faBbCvQ<HDEn7gTMWON&Q1c7PGC&J>QIm^UK2I~1}_Gml0;
zsUX{ui4~{YV76!$7f?jW<{Ms|9NV>#!@iNsg9`84rC~N_PrG|u+1t9}jioV1N8UBd
zMtLU4uUKg;oZH4@f7_u)gA0rCKAo#*-pZbFjh)tgzZe&8s9L{2&X4&;eL5>Sdxv#Y
z`uAa1a8l8=tkKxwUT$wzM>O+{_Wbf|0tvNRC0eo_4$PN?p}P}8fF})IrAR7<hPK9r
z^V616-NhA&{>2H-Q!oIFxN$#0cEHhY!Q4)WVPYf7-u+mTA-QOk<_e|6cR|p5VyhNx
z<ydK9vL$LV@Sz6}xaK+l@(CB8Z}luW%2zxe+wGe}A)7WRRl_coF<l-}TPuQ5!z8p8
zNm8lhI{No3*XFlIWseN!ef{MZRGNfG)dNE9N#U-U_)=)Kh)A|SR>3Vu|H97Nza-Jp
z7=wHMf(5hECkSP`?aE(!k&&q$eM9`Pp&aWeo?D-_U<F0P^zM^~J^`85*IxFs_FZ(A
zIG6=F2KysgAH;Bk>-Jc^*Yd}}yF4C!ChdkKZa8#t*+*Y)<Tevy@P&Nl6CF#(SauiX
zLWhK;<x+RlRhQ^-CtS5WZ3%7LaGe;vUv*LrHUV!dphUOj-A@EHwi|?S&3X1f_Pxf{
zfkpRkVAykSQpFg!($b8U-39ggfQ772iAg<OX&eSb9;m$j(W@cy10i^)pXJ5({s7j@
ztbOIQ7i-m1y#oR=2V=7_0hCjUzlu<W<_8_44}vvJVT7*oIwJ7zoZUHi^IX4wTQS+~
z{G<y^6C^!S;zHhZb%fq~hA?ZMsS-veGoz!vH30CTC-=(F)xWsb;<<Yn+_HHcCK5Uv
zsN)m-)GxHpEko-{_RcrLa*Yw=nuwFskU`!a2IDXL<z{AXcm30g1FynOYq`Z-0#p^*
zpZpmQtB<I)x}{h>%h8BNry!V_Uh&my`#bb`diV3wuM<iCZq5%wV&MHEA!p>7CV6aX
zS$~Dg;<EN8#zO9N3!lTR%4|WCe&%6r%~=>lFaO4h!-vnj|2mU%Tql4+{0sBdq`@S0
z4U(_&abpM^<<Jp8;JG=j$&;>PGFMOT+7Xe@tFj+sd-0M)m^{lB<uPAA%RzJX{{u?+
zRMu8MF^<||)h0Plx-S3uA~u}!l4_1EcF|RbuqC1Q*&vegx<EkRECdYjDs%Q|H2OD_
zQ{cH7FDGtl+$9H&F>M!OpyOTNpZG|?EUP)rH;h)22+qkT7%Tz!jubh(NmtLBt}b*}
zTg+(|tD3r0ofC7Fp4xl}LNc|bx<vPBVE;}A+PuAxr>j@iEo#<OEq?|jcp2l^PjrvO
zxyceZ7jK}sDY{LY^V9hsT1<Y@B={!qjd|Vl0Tfa@0f=JUxVo8OP<wpo(ytm->9HF#
z>C$@roqeptKqV*|NBlDrO~>%UU{NrRcY^QgY@p4*P5n-dBb?EmQ~Y!H3Ek;h3>tn%
zGD#38;jezBjl;QJAg&uvUBhH2s^%yQ`x!E6DKh*wMIeoVWIs74JSx4ssY17=DzWTq
zZ4P4<%?5F~>(ICh!E}d=AkX#-Kb6fBg5F6sD|aDbayl<XrOaCFNFg?{At=3IJl881
zLs0Qu-KDUvfWiY`dn~lg=<1=;`1U+8?_1ib-{5Nh2=xakk-0yozEw{K?QT`m%pWe8
z(zPb@1tpUNK6L@=PhA&-W>y!{Q)Mq@Kb1d04<S#M7P|idmMof|a`*374M2)vba59j
zbwu24p+h>`CgE)<SJz5roo&ey;q+?Di!FML$esT!R0XsAb7_yhHwp_IpOFO_f?Nf%
z`Im)+{89l`yy&~=%~`y2KSNPo3FmOV2NO^8n^THY7XOxuJ_c(=g{oPH`S0Hzw9`~c
zUaxZR?R)b+OTN2Q8}qo7srT45los$H+?a=YEOF?TT(PdKNEVhxkD7Fec?ibj%uN^=
z8rU{N=0gcz+S^shJ7wGzXwttDIZJZAssxj$AMuS8b?jIgY8HF_PuJlm2|4un48D+c
zC*gPzq22!->o91gm}|fEf@&?#fKzn3VAeb(tPyOMM~8SR)E2LZVm#zn<t$eix4E&5
zjVn7qbOYb5IvcWHR5t%T`ZjM`D@)dI4^hOSUSApKM*`vL(-w1eYq|oq0_Bk`rxB~z
z$CNpow+|o&<d(wc?K;7SjdjbarKLqL5xGWtO(T8*&NT7cINO{G@|tdX@&UCV{r1r9
z6Wrc_4~V~$+Z{>Yyfv0N-g~<SI}r@#(-1gtFhZAgmS0@{Bv%;D_b^Ha!AC}Ob(0oU
zX5QMfSQX5sgf-3TTPzP@CQWsAxEXJn;XBFfC-+<NWce+ue~t59I^C?Da`;R%yc7H&
zUZNl9@*^aN6O5+dTb}AxqjHXQuO8=f_nZRACf(7F!+;MB=j*AK%wuaKWsDNPssX;a
zML5FU?UT29=b-Lf45kz4`Wn}N0Ls<JNHU6~#ecl|_)m44`(6`2Wq+3Xxz0?vTg-lG
z)sTQ%K~N$P0=ILX5a?3j1#7$o5C5-%#-R8id>=ed8tNXd#g(IKMsM!XK5Ws!lN|3W
zXjDo{;c?!1p2=RhqM8x@koUWFm`fSfrDdHMbJuD)*|_k{A6T1ut%o!?6>0X@!~7Yr
z*9<Ry1Tz(bc8@;ik0rI-G@}~d+FKa;GMO31fQ>_W<zd$IWJ9>t{JiGS$OvO7(2H_T
zafpztNfxbA6N&7wDnZ7IC|BM35*PgA6uXB1>Qsv(e}km@1v@lixD7tjpJzRV`iXfv
zd;8Lc(8_-GSj$<To1$d=JA1_H{X~7P1Q}xcS3H{Ax9}K#(2jjURp*SmWbN|H<4*o7
z7W8wQUQfp}Q$P9Ac73!Xa{I8Wq}SwU_=eWvwWXH4#ElZpty&Ki@wD#K(HCY2lPQOS
zGw1WTZz^dPri-s`^REk0g>}?X!k^Q-bFk-Gm>+42fgwM?IPM-y*Yg+OsH1$(&3WB3
zOxg-H+<|`3nR|q=hiVGE!T;SJx-1Xg-Ou;d=KNGx{E+$2HAfLdIlJH;@o}eelNac`
zf&<Tbc*od6(MKnsq{Cuv{A(w{Bh`YI(xW^*%d3s8fOZt`0ibe;UKV6c6F)*3XLHCn
z+j3y4sh=RXlB@Ih`rO9LsOOE`6iJdYWpbd4G~d~J8>>=1kLReYefhYM5(sWY5f3?G
zC(b;Q^yQa1#IvRJ#iEQ?8MmRw@p3|IOQp%7Umabuxo>Fgf|6eBgYVzRCjVJEm9ojV
zI1XwNsOH9ap)8%pMe*fz_J05#N)4Hksuo$wszDl4%2|gkZ<@C_IKV?jA+ou%yiGN%
zG&4F(ZWwi(O>M`~l6p)77S*GB<w#}tth9o5!X~fD;;M7<|6~Jsw;WPT1*90&Yy`a9
zt)q@Tu9HPjh5Q9Knu_Rg4p*>d^Pj^8TAbVfUT99*=|H&Q(^TTx^EdU!P8?p_t;yT`
zO|=;qG59a89?SEw{{#3yR*$<MneK|N63bFIf)L=4nOyW*oEO0?im<ePXY{3gYQxw?
z)>Tq(B_T=^+UfA}K0W|-<V5>na6-H{PWDh=b@fO|jEAvF-5Cw!v=e|9vfRYAnD_ja
z;QxzI%-z=+UXzQiQqrljrr}k}I2WTvd$BAZXuLAuMz~NxR-rB5HvEg$j3Cth(kfQy
zeY<xh)AXyNmxYkry{t!rcFSb2G%9nXM(LvA$fvT<BG){JF;kONX30?Eq5f#2GpEuw
z>mu8-`&^c9!7T+r7cDFWKpoRO4oZ6t(B%5utv*|&NAKl+s=MMn*U;BW{SQ$7SckOC
z@H%=FE_@gM?M`)j{G@MI#}O&kTqNL{Bb>?;esy3+^N~AFJj8^BL&JArb~0I=wE4*Q
ztHVy4zi)!=GGw=<FfAdPX_|(Q7NvWi6|Pt>PvJi{C!09p+`5l$Dn_+_2o2k;$$F$@
z-$+caF*$$gYh1?GvUPK`$-%YP?O&JQscC3zO!Q<B3?;{Q5p#U1x7jZ3TP`-b<S04%
zRw!%q7?lNzy*hB{%Z-3o&SV&$W;jHK8&W#2v@<4OgvVF3eu5lnrA5&DK1k@f$BBx$
zn}%UcVtP*$`tbfBfvL>s$vU{2II~>`Ot~HIc}pHIEF%Y2{G>}87VFO#F-GJkPX?f+
zLj3bA4cq>zzUotgLN@hpS$5y9ujX<{(g&Z-#lzy}kcTePNdnXyy9^Uq(wyZo*IF-&
zMtHJ0*@)SPRwi(B_T&EpXfn<`QTyk1y{9ULK{VaoRre-pfA2I+MsWLLcZr-+`#5<-
zo0J9^YAk$z*Vj%r-|Abjd~mJu<9d9U2=G!WU<c17|86JOVMXlRKP_l$WR0Nv#@e-f
zG?a^3f_S%w9B}t#t@$#p@v1zJLj25?Qa*+#c*PUtUGr<6rH++Q=qyB#{iAgLq4V!p
zsYjN@`hJeFN$13%9Ho8T4uBu|HtXAid&oxURpV~bnOb$#Shs^@DDKb)z8#oJfPeFR
za#l~*Lh_WsV-j!KFo)p;WNxCM9eB&yV}xtBeZCQBulgUL*E2r4P2%-v0diT|$@hPo
zAJ>Gb{e(k$e33w7RJr;@#-&VC7d#X_$@4$15Jr_olrpK`B+m@F3F)h9Gl^6gk<<lb
zcR)E!?(cRzB0h600i730i^SLEC`ITg19%^8Uq~mtJMvbY)3$0$Gy<lVOo;3k%G>fb
z3rwDo9}oa6k)`sPNz+kw?JW}MWIi9`IJ6e7?u|_Uz8!w?BSZctiu#{idD}+B9X4mU
zUY0r_Os}`!76e6k=qk`hP^#9L0Keyqa+B0Br)j%AAi7uNjWAnZ$r07Jc_31VYJc>t
z6?Y%ebvHiyfLijni|x{glg$XRj>oP+^3mgi|5Hv5H38Dgbp$j7(nAesY>q@SBT2(N
zB7e4pyIee)QlulGde!H-;oyNUGe5mEF-%61`}zL^<jjS6^L1yX@*MfxxyY3(4IbDZ
zKa<~G(JKS+Gr&k^tOF<m-_5%7!D<_V1c!hT8j?U+ApkTXrs;P|ouvayb)HfdeeXtH
z_z8apAq(}^L{C$3NcTK3NmJwZ_>-6FIiOXtO;2=K&^{v>MMdcZAby1FUP>qQK8=Vy
zy%&kr?UwG$MC%HnL#{h^5#LtnQ%WK!{ZhKrZmG~uhrFLdFFoOlN&dW9#vx#tbrQ{5
zn921w+AH&9B2E9NPZEJ4|ANtZeowkE-Gu>kg>+Zu_jt;`Cnm7Jw2$9#Hs7rA+1Gw<
z;h}~oMqF*khl9ugpdw@bBvUM;{(4+LBzeH*Ru0i@kF?C!S_@4qdWTom39fe`fN<D_
z(~^--C<UbUXEpUUd`MIrjq}=cp3b9XPSYn$O!B>kz!;CYnw|w|Cs6NAsLT}7e%%=2
z?HBSY^RXHT2mua5v5E`7vx)G~1Dpt^vmuS!a}zl1e|QN~VOaFELQSNq?vWv6BbGw9
zKzN}CI(x?9{{SUH+P;dWRz@Y4mLzaGet%l;JP$Ish@lx=6Ors|&&Mxv=Y1WUN498A
zqTNF%=m9mdv6dt^Jadk}t$g#1n`ez*_>Ga>hFBRBf=3x1)#RTM$@>)GVD3}Kc<IG$
zgm2m}Q?CVWZhXUb6}4j_I6JuqkLB0X@vZ9yM^K~^2i+=1BmCyR>aF=wF^kojkgB={
za=<rE1~L9~)}#T{?TPS8;D9hIhDqG&gH2hA$`zO7z`@*mbv0_%Hc;3EWS-`;mF=mj
zO8OJe516DC1mi7`c{Qu>qv8eU!e59Mek6<;EaX3Cyo~3VoZ$W=sI2)NYI3C=+SAu{
z_?+0fQN&V}IsK&9-hI`pwwtZ^dL2r|{L4G&R$EP-1aHzq>c+hGZ8Q59O}brL;C-6a
z4B}JB2a>J$V;@c{<muWi#dX`~)AaN{PX{?DI&Euz#ebXB`O3n^!aM7~7NJIiQl4n-
zb^-#ZZWsf|9dY!lclRG;U$k44^CV5UQUGsy`r1$0yLvCX{t5LmykmKJ`M%qgG<y|=
zWxAd4@{nX~WQ=qipL15PEaxl`#N-f4fV;2{^!2Yojvjc4`>N>}POK@fdD*_<rLC|&
zY|FKx%yGi`R%XXho}-F`RoC@<J9cY{EG(_m<II?n!>&H@0Dd*3ux=GUd#CC*RZb6)
zU;6&GJab-x;9T6^T6nfY4bdp@mJc2QKX89h>seZLoz47jHO--l!Uc9EvAy`uQ_ytJ
zJ?rZ5iV7UjRz7PT&3}3MoPNLKX^9q=_JSy)LWr^Or`+K4$Ln1`fb^(z{{RVV-a5Xy
z6I|O_zu8@sGRGqUjC=gRV;p{U+S}!FXP<VW-*e6UKW!!cwQX~9rbTO%GCoTTWE_+H
z^Ie~gwFbC?Jv&dhV`nAm?GW?ATf(StJ<I+hwPh!0q>YlilQT5UR&Nd5$vv7)_PF7Z
z8ReDmLjnl^V;pctHM+Xirw_vW-B8?amV3`87=n<hGnQ~W_1lx`D{2Z-BNCO>maU_?
z(S9E5I*-BaFTmObgm&7eh$J_fz2kl8tq0Da<DPH^4`S8mzYXoKyfLNP{44NOEV5hO
zEIOUu-}TQbg4u6H%8$ai^GPYul?T?>^ndWjoq>vTb*J7^`?O2)KA-R>fHYqP*@uV;
zubHtd<Z^vN`g2_!_0||O4o-L-g?@J_ds*`j5n5GhIm>op+)RxlGR6td9ODPn{&gJk
zM+_|Gh++U49euI*Rb6#5N$8PU#U;6w+C(ZbfVs&gw5$+ABglAC0U#a*Pfz7kpwbGm
zTO#4TX#&LrCC&~p(0gXN?}<7dqpkQ_?#dln=Ge&*QebU|fOyZp^{nR<-Q}t~Fcea$
z2R`S)w_X;u(0oAecCBN56zpNX0GRh2;7SMZpYMKk*w|03==#hW!s((5@wOTEoJVw>
z_jW2l;g3v@eEnS+I?z&GSM~QZ*~d~;>N;%fwHPLf-EMT4m_;rw?J>h9a9Mw!A6oUV
z1+~Vc&`At<X`&mwj~xD$<>v5JFwL0d@==}J@BMw}Vd6g!cthciklrBi=D7u(y2e>x
z+&tM&Tq^bC@%Y!me;<Ep4;Or2zilH+mVFn)5f%_wLgX38AT+EG%ugJ2731*!T^wC!
zT5H^g;{O2P8)7OtlJ=cCey{wG6}7TyXLe9=kOoNV2VMvH_pLah5lE3UBcl<=ex9}W
z5|*|^MOj&s%`(Go8Yq;oA+k;|IpgV&Irpr&8c9lQMGRP;oRgpB$o*)Jsk1v-ni1NG
zUORIlF5)@o<zHNSf1gVF6X17-mrS&mQ+TnTnQ}Qe;2*}h@w4`LXXaHsYFzd`4tX_g
zN;m-|Mt3pW-=-_kqliR-R2&8B2l&^<V;3xxPKvb@tcZ+@!eE>X44!jL4CTs};~fdb
zb0uvIlDLecI3RW4Vym*LIp{#Z80%LS`U0{<VMB7RNhhcsJNKr#V2qr0?f!rLRjbm#
zx3L6@ND4cg0zGOM4j7Q7hB>OWv>aOMcr!Yx5(gyoJw;TL3coiap&7<KYkh2eYFg@N
z-M^Ngf&c^ogWJ}-Ux$+J*jO>h1Mu|r;<>SjI!&Dvq}9>x-XE9uN{T*J9Q)SjDgaV@
zjE-~k{{TLf^HSeK%CCNQ#k&m9l|0~JoOG`t_=<|wb14`*N!{1+tuToyiTWLQEmN`b
z{qbhjSy8wLgOEG=*3O*8qu!t$pb?Y$9R4-;Q%%JgFNvE`p?H+#O5=e~+Ub^61nvU^
zuj%;L8@oDHqB$6-3JWgo2tS=&w*glUxY~I>{{ZI|l(w;?ZF{p!MtqXYHj)7t_8mXZ
ztzzqzsL`1mWGN&S=bW0(leE>lg!Q{V#{HFU<?#o>i+gQN+EZb9HLMab&cy*pQ=Z(`
z?~nAGd3-IYX}8meW1T`vBXPBJ^AY%G{F?c!b*SQ-OJ@H7JwMC-0r9t#ar1)yYp=fc
z`_Gs)NutylZK8P6-q}_d0v-TW#(x}V>P=$Vo7=5K%|DotK;SOy5PNQ~slq`<7jIwl
z{{Vu0MON+0V@~4vr$c98LrCkANaK#Y{*^7Jkvv$t)vjdTR4T-+ff(<cS68-lV!N3t
zO02Ba`;=$YblZ(&>6(p%Mkwu!zIwSk7&ZqP<C9)t@fTUSxw}hUKUSXN*J1Ml{P|q>
z-TDDu?gqU|l@&Ugt0T+CQG^qn9WA3r0=_7VPoK(o(4r}h*aA+*IphQU>!j3mc<0cq
z;EGTTvBuJDJh12GC+Y_t!`8jk8#|-NoV}z{N1W=~Rm4sqxwlA=lp;*zHgS)yf6lwD
z8acI%I`iS=FMw>!xZ`f;WZF+1ascbzwNd6)Io_JShb`hLTf!?pg<*?l+B~P0Qlv2m
z#DxF=GrPWfVzD5+xQ1MwO7Os({YQU(mCGqfOGa%QTK&y=ymzl#MdTT6+0{W-Xp;qS
zIO*JdI@ed>DD|%v_-@+RTiZovZ1*oS`D!Cg+dg6d`iya$*3iUC5pt8!88|A9CBOUz
zdVj;q?RNKF5yxqFaSe`@36#e!)qRXtbNd1}eQW4nhdK?$iER=-ijYfjFuS{*@Lpbp
zM^1x}%D6Mi(4$2=q~&Mk`yPGYv~+uaTK@oD5$OqYcPxdJe(eT99nUpWQq`Y(A~ri`
zIVAcD_;|yWSZ*qFvgkn^w-Q1L`|NT@r`Oc~0F5I!-WEq!lyXLU0nhWQYiqDcUD%S&
zS)S+Y_KIED<;dk%r&C=mu9B+{nLBxnxj_VA56-Gm<W}l9(&l{fEyZjRixdEi5PkWl
z-rK`@Y*uJgfDZ3d#dFU{ok`wFpC0^q@T3+RyIk2Kub4_4kCln+PrZ1JhmEA(JRPrI
zOc8)xGT}+gEra`qJZ?jum9z5Teje^iKW$0D^w;|Q{zuYg^zTlUe(4^K@XN$A#dCe(
z9YRT*Lz}BMlQ{vu)*<x%@E`4aSG8!mrlFwd)7<GYZICJQ*!5BLKA0o$t@Ao+RAnBF
z@u)|Zx=&QkjlXCQ66+fO0F0%Y{{U5*?U4e=vPfHDJ(PC(SDQs3cG|dL1_^W2*P)iv
zjT{^!6>SczTK)5i=xbZseU(NSY+;-!&OQGCm0a=}-^^531aeM3Qh%5D16JML$d=bK
z^*KR}k}w9$f<Xt=@z>I$u@JObB!YvdUQZw4RkR6B-06HBrb(;nsTkZ$&J%9XKpvyh
zp|7d5%Lw#61`9YFIEZi$2iN@jR|ab<DANi{synX$+Ia)*Qb&(7<{w(^*~teu#{ds%
z`8-scs1+8rAan?&y?ST8HBUGU2fsmF{(zfq>|s!?mSc{+c|6o?6fhXZPI&s&!QWBt
z#BiZLQh7Kz^{5yem1RDM8T2(*YeqChA~w=C9PkDQLsjKcT((BgJ9jlvdX$n{BftcT
z<T;RW$pyXf(x9EukjJwa9E@Oe&*hr!X+6)VjqZ%w_}gG(frFFR7213|4g!~8*dYAA
zpXb`Su{KniXGJ%6bKU$pF&g0G<pU$o*F_m%+ernF2Q~9G6`rS?h}LezcWma}$4$VF
zyz}W^Pw^F8Sx7)QBO?Qr9M-s0-9=-s2W4~R{YpKWw1^HLb8<#G2jB7ht9MRik_J{#
zF^m8+o|qN)6L*SFv7Yal8weGFEUGdOZV3G<W>Ua6%5j2Jag*)&R}*UXXG)HQYKr&_
zgP_4VAFW@uMN$)X8+H$HNBRC$l=jrsKE}KNOq*kmCkLGNtnEtNJW?{L&O7Hlf5Na&
zmP+N?`kzsL#(JH!-U8LM4={bA%KXgfo=Q58oBseE{VEUIv&GYC_7+|fvv(IasARY!
zp^P^lndk7Y4-rq=W<0)k{BQYwXUfv0eCAi^@BaXjr}^9NK6S9Xku61uTrlN}3<e#~
z^Q*>Ni<pI_luTLFlIn7(Gx}H4Q+iqYp6yj0XJ@%`)Z2JxPLl7-GYHeocLWkUbfv%7
zt@mXv!b7mT$Vl7H4i0+?YBH@peuXy}ClkRwE%=X6(>zfe+9shJ+T27&$QYKvJmmiX
zo`>=0^$V--4ET8=yOqt>sO>3d8=OYC01|p<Kc#(s5|nAuQ(Lrrt}49hNx|)Nj*K+h
zBxPm|g;oQp;PkH3!*}stX#W7&4BlPrPVz!>KyXF~KBI&B*P#ZUhXao*)OU&`I<AXs
z@vh68IX5(Aak)Uw20LdYR5zN2q2aF?>H5`z83@zhx|sv;-APZ(55#7-rMfbb)y1>D
z_@$-zSHxNmhdgV2c`lc6sw1bF<>gs}au{)pV4wd0U3jO6qqfqnjisKaZ>T`4ku*D$
zci@Bn0N3g(3bBKhjG7advQ7E^4#xMwZ-#pB#eIBRz*;Rj*@Ir)u);!~ne{lueL182
zGCm=_e+76#BNl@IM!CHtg<zj}pIr0rUPe0^2vqhDWUl`JL%$6kSW6Jrk^ZcDR9Xgu
z;SEyLNz*LdEN|@o#Vp4G%Xx~$kLA<ey^0iuOU1NDA9wd;blNe~+ogFKq~(gEM!Q?D
z%R|STlq$|L-&RSgT)}5+h@7!w&>Rfc87%Wpb|fX6cT5jc{{YvoE-B02D-Rx2<s)y*
zhf1+C-ObB_6-miIL0PsI(%xMg$y!V>04NywJt`+sG0`nfycQZ&)T+x!oyL!7mcwLG
z1zZu34=3wemg>?%!H{y<#xvfryKdyx<xfG;TJI%+;EqRHu{N5{q!b{q$-%~Wrtc(W
z&&tvBkL?ZN`Hr6?@qx7o;~DGTz7F_<43=8bAzUk<DqA>K>t44H$$MuL>#<MT<*=IQ
zcHRl`T+OIxn(fT{=1Z94yd}DVN*}I4KbfzsqtoKG(De(w#iK=e6z(S~S1XMAb6&1t
z58d*=>r=wNv#A*_r@<a9)ZbOtFYj)_cWZ~sGh={o20s96E-2WLn>HL|fG~SkqfROm
zqZQE_)NWOrpL13M5diYoa6*RT0E6H2{A%NfBDV7ij1CKK#{PK5PdwIMqLr_q&QCd%
zvWEaM+)%d}!5ujF=~4mZ#E?e845K8Glg<Zk&b3PIM4yH&p5gEV!Ywt+YLdtDDPE&I
zf!4j+OH-)d$7>#Ts05659Wm)%4ry1L64zv1INB#)YR#s@91$P^MhG>nZ>d8f>~Vsl
zJa!nbovR*q%z>`Oknj`?vM<#1sByIJNd_<vTEf=cm3!D!ljb9)K?DKNQplh#;7_5z
z^s3XE$gM6w%y3A-IlwvNrA8R-KQa0q=C;<?8nv_;AS#LmIpCc0RPF-cw%i;JPpv4u
zRgELA=g+|vV!)HR$?9quCI@ov0P=XxeAji`N7LI^WKg?xRN5QwXA6^>?EW3*ITd6$
zJbbOxbNW^ow`wfXj;!~84&q3VWO2#nx;VfgTN&tmb6+txXLHZQd~FFiK2xz?HstrO
zB>05PEoJ~`j&epi_Ro6L1iyN|M@9|VHjkOLSXs4~^3Zdim<|UyHLayU?G^*~0N`YF
zuez%j%7~`ZxxEx<i?PC-9G(YEbp2{p5i0Fc4it=leX*M1mAV~KOoWy#wL#~Bfz*GW
z<y&4Fw9}`*^R>s2+Q6npNKeluKY)5?*V8qXNjSl@wdiSSS*U3G8v2#mYI>a4&{;)m
z8~l*l#4xd<j0MT-_3zD7lGw<bS(#Ml1P;~7X=%*$>T3j{6&2dYd;2<g!XJnK01;t^
z@ygh17__(tpd{g2@FZ7B`%+k5C&YD@avBM2qi9Iz04F2-`qwQ~mN8WBulQQuhvIm?
z&yzM&m)e8-(_f{JACVsYOgeZG&X~y~01h&1XGye8J|?lYjQNuW-7{wrduQ8<^rIx>
z$=9!^^||RvHg{$(jV-KQe1z4mp^9jVNdzynXM$MwuL|)Vv2Pqtr0DnG+A^7#D@Ym2
zE=S9Qob<=xUqzNKc=AR+GsetRslRC{e2zy{*X6&sio)hAc#_xUc8VdFZa5?ka!2V~
zUlbkg{8JsRv@&@yTEJrN0A<hfHSfX-5J>PUPo7s=e@M-dEiGbL?Akd}$|BDw2PMep
zKQJnlzng0Z+Tt>af&Jej<zwrQr|a!ht+<=I)YF#!<jrP}AQy6kkSiU#m;r&$bNy@3
z^&bvsny#I3F7~z7rm+^O0{{SIl}l|Wrw8&qJ$k9_sf9%BtXI77_lULMftR-T)~V+B
zQ&34_l34&AOT<ecB=QF}<sJa=HnZ_F#8BuOL=E#C$tf8~qaDw$=U8GT96FThZ5y*1
zP06}(?*9NCe^c#`2Y3?4Ow#SX7x)Mign-(O=om8)erIF-(0`?Sc8lTLJsU+jPKcpx
z;{jQ~8>e7-VtqLk`R!`Xt>r!D?)^G1$o8>qVW~!f>8thrza(@1B-6aRohn<D0Y%5n
zlaYW$cD@+3ihJp9Es13Ss75&`JL0_>m0U2iscxPA`=2|B{pDHKi`zmCbIXSHts-C+
zJ<NV!Mo+zAUTT(>q&#tXvYc!m)ca%)%Dm@3RdcfmLU@N5E~R@&u5}B>zSJDNiU2?l
z%8Td+YU{KsbaJfCfsMF5D~IBGpFxR)Xwvp{_D4}-tq?%%jimGKT2Lbu+7CgHM|#(7
z&!4Sp+_z~O{{Rr=8owHhbteP!6!d82lXukeuZ;RC-)L7JWMG^e40f;1Ka3h;t;@>r
zWnp$u0Kx5DnLN2MX!}ehs^v0|V~g-b{IgySGH2Tz*67G#oDwmRez>o?z7=Zs8t1|r
zeM0&7xzpsgxa0m?LzQBGEc5GMO_{+eck}+gBj@KOD8-}VzZKX;XRhitkqF_5r+11;
z2S83#9@se@e;Un+rV5^8<yt+UXCNpezE8L3T`JOok~O@P<rx=Zw*m4{=Qup{BbrTW
zK^$9n3d9mm8OZwcQ@cUtVp@jtGULBa4;=phI+jSJzto_#w%flUS3Gl^e~0H<)BYv<
z6EB9x*q;n^C-Cotph**Ch9C)HgI(u?^wpL|ym5m4a(^oL+-+ObsWYP1rF3rITRC#U
zcqD>A?bo$Xk}|AGY#edMD~g=D5T1j6(<DvuzZlO>rmUu*=u0sSI6JZJPH;^FY3@rF
zsSJgIU@_eE#aoWyWlZnf81fH8S-46pPsnS?6lGtj`qT`-94`yhQ)@xNk+Xshdv*23
zI#p@pRt!}Rcpq9L?wt@#yCdiCHbQ_5?l}XV{{ZLtRcQ!}7XajSAos>GpT@gYlGOTL
zQ?Wwn854M5K^O!d(~rixFNaDPubAbVAmrogk9x-ye`49CD_r;A4FJ*Y3D6AW`*p6G
zGC<Bdjyj6@nyKu0c(09--Ycw3MmlG$c_+kdC5+@TEsmYX)~^L6?Gw4xgW1^mrv6C=
zt0o(6UjPHh=l=lLTUKuzsKIb>F^qGX`>KsND;cQTO`7PXRk=KWKh~@)U<U*YkU-BF
zKj-<^1k*a;)rMde+5sdEc?Z60Q%aNUw<{wm$S`*+41=C4Dw}9*mX>COV8H6;He-wy
z10x-}(zWag0eB_GcqKbyHOSMJ#;vHWbY#{L$95&uJi~1jsPh_2fwOKo1XoAnKZ+^w
z2Takf<_1U8?ahR<vJlSW8%t-dLC4m)>Oxg2sU`65^Zx*b{;qS*5UExZ>aTB_{{V(5
zXxd~JmeNN%p`FGjE_frR(T<p?^$kwe!p2DqQp*aGRHqM+cszHncLRcTpzBLT)B5x|
zarn5<nu6V*J@~)H+P8@{%|h13ceA&(f#<w<!Q4?sc8v7Mz^;G5dVsmp{6%>loRVBv
zTluiea%7A%1W-Eg3vTt`3i})e7C3q~Tfg!?TQS8t)f&FdFUaKN(q0RDX<krnE|uq4
zz{?21AQOSqk;l+_*Hde$>K-oA?X>GC9z9;&MY+Hu?GOM?7@mbjc|DJ{blLnU<<Tx~
z*D83b-p|AK*4i4Fq_~a8+GL9hm&e@)*c^U5)omWt^-mG$`c6Jl>Ld%s6cR~4g-mSS
ziuhr1Z<G6C-}`RSC7GhQpL#0s7zKQ=4m;-+(OX>WJ|fY)ORdW~q_$S;aLRr`9Lxk|
z7eB<oLBRB_V|5)&=G1KdUww?<gMKY@d8>FURTEt4{v)<)c8n6iCLG52?Sqk@_Kkfb
z@Yle4Z^O+F4+wZ#Snu`iO^4fVqB%PbMgi;!@$@+LuM0h>{fubC?LB=z;m(}0lzqIa
z&*57A%l-mAzd_P1yeDV&3sR=x$TyOq&i6mU5BElY6J6eeG;`U=Vgn=qQ1gS|AC-J^
zZmnK*xApmkV%w$d9_`)!pK{RVJ|$_Fv)D&>rI1=LlpsBKNQ9m}hwEJ}t^K}*r;`$e
zx|}iFj)T^{TC?V%1h-c_IH^=zo%cBTZ?3Oz9#la6PhLK!)|myXNX*j>(l-pmcH^4!
zC+}#sKEnftjvgG(;%oZ*&HH#3Ft}b1eDhk`dGboAU;_|9J+WNxeF&|2MW%HY?p)__
z^dR)BvD_k(xyWn*jPb=??2iVdZ=rSxfIOZuIv(|*3#rKGuN7;t$u#bBem~RGP|>bo
zL6_J`7|$NH`RDPk!||KD_)3M@mjEwM@_(Iaf|93+i$234lb#BtGv_Fz7PqQk02GjR
z#t*J*?f(GTmij$IK-Y8@aU?A$y+Fj|3y6Vn)28A2*V$&4_7_Knm7v#S<<E*X)5YSO
z!E`Y-yb;2&5DwtKCQtkcPv=;c<w78GKs@arjD39$f0bP(-6*qqi{EzYT#nq5vaE$r
z9yfJg#<MjWmX>FNL7qD&r{Vm~HD@c3o|YkxHt;;2U}6W#NbOyp!LJNW;x7|Le=MUG
z$IKw9B>H6jG~4B;Ir$0b)`!-UZ4g6a5ZXej@Nr$Xg>06V3Iup1bAw+CUQNec+d8VR
zby&300x)y<4Ae_+6zp0-*PsHqm%FMtWUNHmZsGEPF~}J2)~U;Ar0gRHj1l#%l=~F5
z(9N1TBVwQ&6M>Em8{QRPE!jgiJoc`w8&@Go+<4UIjB*#L;M9qK6o76eeGg&&H4~?<
zn;XH$mr}%1t1p_&F`f@zGfa?%055UZ99KI{Y;;m;=g%ebilN(soPpQ;;-Pdb2xTKD
zj&L#5S7n`<^y_;vwcKnY^4*RyatZIxHP`$%V3UH&fCtPo?^)Mt*t?e%?`V7Phn>s{
zTO9^K=DK*JV7Tp`gSC9sZCgB?LP~DKF31s+jz}aN^sgfLjEZdLzz2>q-vX8!TBz*6
zXwRATAYWEtyOX;F9^~*VV^3hb5*X)_GEYkT*{^YW5T2~uiB?6%;mGAz`5KX#hXD$V
zE(suldV1Fb)mfbpc3_Oe?ZE+fCvO<`tt%j{@-gq%1bbIKRMI*r>T5zIUAbfTc^Ljx
zx8ZLN-*~sg7Cs!)$|U!)h|%2PS3OCtCYJ9+YgVeGPE{X7-`rvRWAT51z8C14*M_IK
zwedco=fxUZsAVxojq^KtpgA0MIjk>+zaFf7cMJSGhrkLR?mf|5f-`Ir50G)5qw%i%
z9$AaWVU{8j<c;o=TH8<0Q^2c@rR^_XElJu+&gnJN=WTs<Jr7*bwO<9>M|a{2N$sPa
zHk#e00B>G0!2Tnxc^||th&H-bh;-dDWBsY9VbSsmDxRGC1Df_9`&K3xT7LvuUv})8
zGmNnE#<zDX+tT*2=Gv?>cvrxhtIq8`_Oj7gZ(tZSxeqQ6eX3P{q>7*67LfXPgZx?I
zYnX(#iD28KIm>Kt{kvgE{A=wrigwu_8&Ymb$@Q1&zf;bvWP8T@UCrN=*AwzU$qEQ;
zW3b5|m3KCtE{4j|dp##d9%S$lJ<EVvR0HneN6Mu2$MvpPQdY7%<rQsCChlvUPUY_9
ziZoOMfxuCWV08ZgBDZu_xVD=6Teq{4MmlWi9Ed(eW?h@Ndje0cMM}F?346-PmwYh<
zwto-&KxJk7RH`00*?C2cqsw#C?~lM5&ewGd9W%rFW`QNtuHH!0E@FjG@9rhRUG1KM
zLgS9@>s>NSMK9~A&n;WOf6~XX{2cHE9tiO9@!q**yIt2K38Y!FgXIR}%*H*xkoB*p
zz8ZW#PX=g0>hLtaAk|dKJ2B?oHvR$V$N3ugJlh=V&ZMIBZ<Ts2-{yLeglS>p7PXVR
z^jrQvnbm8yF=<v2J4QE8!sPxx=jmHM35r=X^6Z;D!a(=`06f>5hmG|->}6kRhH`zw
z#+t^3;VmTUTJ7q^1bnKf-10YFs-u=X^cC~AvGK#i+UBVwmcAXEPSRAi#+h?8qZ}5;
z3J;(rx-9C+#caQ?>;4JRkziG6dwR>=TY10oMxLATn?<)s<J2VbOP`fW<MH<6J!`x0
z?~Ob=t&!wi$GDJiSaK^l(v(&DA4^t?vy@KW-D8pwBD%7Hk%N)>(yXBy%wz-rNWuJ#
zaZ2lB&Pwg0cT2k7K@Lbff)8v~gqI5&h6kLCWMk5lWpsH}p=y>cTHJ>?2R@u}T9&s2
zE?95?AN_i@Cv%3R3=bH1t4h-J`NieRfXc%GhI&`$x9tVu`#H6%i1ebYvWDK+>M}tb
zel^vXL)&7Onj`75Wh_1(btSVtah6S&PQy9f&f&m5xIXpur|g5NGWgO>CV3FG{)Usr
z4hJ#F!GIn33Vmzr@ynYHFHiD3nx5*Nk3IPHrmmOctL2gsKGs2oLOxOR<b#fW_tUL#
zS4<U_GNvOE3>5*D)cfbu=cnaUhJ4gw*;SUQ#FF7+wXpL%>@fr6Do8zZ^*z51y{n!{
z8RcR=a>N0id-6TF^ga64klnH^b#b?ae5j&~1>KyVbNJWNKLETr9fpoI5f;ag1|zxR
zvB%5V;UAe$PE|EMZ%BaOYWsqmCIQdAcWT~Bg$vPk;=U^tWhEAL&sH?d7yzdnaC3}*
zjUr4HfdHOza5G%bv4e?aE|r%c6VC_ItKAS+%oroN2Nh}CMoLy@e2_&p8A0jE_o{PQ
zxl#u>VtMC^=!E(*WpwUVHgASv2+vcDR1-#GV5gEe9-V8gUFr%+4NHk)OnIj`9Z&iH
z04AI@Ss@@uGoJY7qI9{niP27_w3k!F2G>#&FgU=^`TqbprIs)OA@VW{Dd;~hty8_V
zXVtf7WM^N<k*OpcgMhuxYpM8b&L#|tk&%p!dXHMi5dQ#h(>H=#=g>YIV#F&ZMg|D$
z?_EL`P*i$?IIozh{p~h9%tBo43v#=y*|z`(QJV5Uh=}cDICaiJ#zp`=vsZ@JqOrCK
zq}pf9cZ!RuO0IC(J8*teTUv60t%nD91S!cs=LWv+qrEhdF;<&w+l&aI0o!>b6~W0I
z^e5l^DKjDxBW3_&BE0!MPPoN&8ymBt2?jR-p5xH{YeLR*81oevGJ(m)Yo2!4-7bvi
zG)QOE?&Gw#7<V}&oQ1&W`d6Z9+D+Gn?rrrwF6EZ;GrUTx_f9)|R~>yK;oQ!w<0hdk
zndBcIei8V`#oj8?bqy24(fK;fv?$lPEDXnY-#Gby#OAp_f!-1EPs5KF>k(`A9!goF
zq*F-0xs}888TIt9s>^Xy<(Kj)d)&ACx_pn5t$LNzAidl2zsTJ9$K$Pj?@`or4-@!`
zNg!CHxU*v_$PqFypb{_`5Bzq#$HVq(;{9^aMQ0>-_VEP)hCIeqC#mg`gYDkCIDZEU
zP>ZC!-Tw1j+YuN>RQ9(;)2_u`Z%)>{b>d4c6w45>wUMo$b!?zkY{@9cb|-du?bugG
z;ja*BHy$F@{ukL?{hv>{(k^t(>_}5_k+q2S+mEXn`e~%0%HMD6?mlX)5{rUcEBx<&
z^E|J@+Dk{RjXv(#rj`*htb4+Z>JO+n<aG9}8y#-e`&_rRxQ<nEa}q}=by6c4Ql)Y8
z3=zrxRm#=fj+rMdZb$J0NpB45(^$k#E}3o-lx^CC9zF2c{Do)uTVA~I=BXZ_vX-}(
z_i~|K;iEVNV<S9g9`&4O$s=_hcwHTKsjB#DJvzesNSa5}5*x_1Xba|aGmru2?=Q-j
zIqCp4KfvDuKg2H<KZ*QB2#>@1BF5J;GJ>zL0FjLFPs%!a<Gp8&#VQzS)JvwGyMAU^
zdQ+)27rp-gU-)C~F9Y~i&r{U@0O4Y4wt(6~q74$(LBQLbHb1&L{{Z^y)_gmp$tgD%
zO3WCRV%>ArzdNY;=NLb-zZbdFnAcHLae6Oxe7ApjhvFo;*Ze}3u_^mJIRJ77G0*w;
zr+C-L{u=mMrblgeGEb^a9&K!qfMN;z?Z?Ww@A+2hUdkG7&J{wYE>v)I_j~@Qhu!$@
zFA-}00NQ>h)FPTvK3ItXAYVlv=QLmZN$_=^v8HKP{{Uw(YLDarw<Q}KG4|shh^(Nc
zC(9n!`?Ws(VPS@+8dUU2SjPB|qkKNPx_vfzqlJaL+_+K$Dyip>^U}Pp{t(@3O)%eR
z7xUX0zzC*HlfXE^^yfcH?!(uUg{HI*VwzH0p0n`3;%|+#+0#t%E3M2dLZh%C;2eHc
z?yzf--718ea_z_%>s(l>ag5uB$1Qv%nwv*Spj?SgVj1KT0r|W1t=oirE4UmsdSK$Y
z<K}o6nDW)LDe4;au8O{V>|#|?$8qDOcz2F}XfGMO$4~HufQB|=pJ|w3N%kL=RXPr|
z^>$rN@R%r6_v&iDGsiW55O|NoI;o4q9zIlYFh+?a7$X3m(2{=&<UCuW_$<pf`*hdR
ztYnD`92|qs{{UOwy=ci%Y8Z8|bKIjzS^Gz2*zp}#O%@U(qNo!R>$v{_4&Xn=z1#Lo
zx@dkZXfn#Ly5hp>6$7BbQa_*TUr$-{VH<s!^4NsA=8>uUQ`n@Ms_IP+Ue%o?Ba8-c
zK|k;zkH)-i-es3hw{Z!Ox=9l`2LP!J!TK=bx$uok4-~o%dNleJwW$>XnB-J#yM_lt
zfyHMk7jWT@3oBuIboUtJrFF&HI+1UB<=cBj)vsfM0lCX4AooAy^slb`DW{DS!q(Qo
z6&xtZ$5Z})m3jHBlA{>;n$b@8JAVgRi0#ee443DTo@=6-Rc72@pw3TU(!M(o`RX=r
zZEQeT1|vNVdHT~Ci68)dI0mNrlH$ik<n_<CPgDL)I%Xv{vBpklb28=Btk_UCj0}&<
z9e?`Npr-7W!OsG;i*HgStcQ7Erc7gwhl-_hY=xB=;{zB6j-BhS64K^Y)XuuKk|e<y
z1m`Qs{{TPXSocA)@)SOqAaPxE?Ja>w@$q!1ft46K^NpZ)JdQc0Np_?uA&yT&^c+@J
zZ*%Pv)XUWGP$uS5N#(Zm?~HnM{VS{ZTX?M@Om4v#BRqef@T{>hYYy5rr6td1eI4O~
zSpid%fCY7kM*)UTJuBoZwR@g!C*x!{pa>rWjCb!|QSk;s)-x**0bFe(t#5{Qnu<Cw
zD^|~!b$O9>W(Zt2m`gA?=O=;9YS=uHsVIfA26!H$t$n=RqP+@=ZM4n!CX9>_K~u(h
z5$pWwHkkn27a1W*$K&3-`CYTJ7PiHEi?oGHGi8?`9G{oicCS(RIq<(#@$?786T+X_
zo_MuF&5tr-dU}vElT~_jAnR3jNaV~hKUc%KE#8ag{ao}95$L)fh5Sn=hIC!BrHp89
zCE7A)Zb%;3+sC=5%XJOCk-EH<B8Dt(c?bg^k4o_Vw>)H(Su1lbK6@D9=}I&p=Jk60
z`ks67N8=8);L)e1fcF;#9Bj5HD<I_HjBp1hoN-?^d}#Q=sd&d+itkLnnm^qXcwvzF
zYbhh9I6RJ^4lC?3Jer+18Si`Fx3B1VSj=xKZVJ!7*Z#YSYvCXGM|2<Ue;?`({h_Nw
ztp${bBzX~lDo7xl@(*G->0NZXmW!h44dBaZO|G-5K*D1ifNc<_L_~IG$;cf#SKGog
z=`Uv!<=shDe$r0-&i?=<{(2(U!~FpLw#w6KRnqNbzMfX-ssRY2Jvit71ztI#$rPS5
z)UP6NS&in|H)N8?`&e_yCm)q6w!OUv&&^Uv`F^KK;K+xFJZ+_G0nsGYE(}*NmjJBH
zt@8ob3~+ewpK9~lm~QNE9!wuH85%MRa-<x6de=K@F7Nu-=!?9Ze3$BauZQH&ekyo&
zJri5G`xd>XtC%i#e6lBAK|G#u*x+Z@y#D}N@b<6a+lEW)Q6-^}BzJLq@knq;!5jmF
zoE~Z`K}tN(=oo1@)O6%zY1W#av8zL(=z-<Czmx2!fN;p%5J%*H4A<PB3_cfF+FEJ9
z3UsfM-ohl*b^EnA4JL9>{v3OB?OqOdTb7(Df7{RGcHw30<vP#o-~I>Ud-M_8+|03C
z!R1<8k1E<efg(}B{{TJfv?$h^a>Ej;mQHXpj@9y5b<Et_JgmXB%T2%QspMZ6{w`@B
z2lTi5ByipMn*K6uZAjd)jDN0>c2SN886(p*@V|;aCisI>)vk3-TKZe9O7nD+%_AN8
zC#E|AjsV670=+y28R8q1zF(>D<kZ$4lf}<>qV!+p{{Tanyzx%4c@m|~`^sYtv^OUQ
zuh+FfrA4iHi&3|Z)hC)}Vz9ngoxl<RBfd!d`&ZD@!c&UTD;-sFGikQj+WblQH}ONk
zmeF{FTDQHCXM{6c24^8i1cU53@A+b<_)YO~?e&XYE5(cU$OM09ww0Iz31iN9=Oc`t
zL0r|a(5;7l%~{20ECxT?O-ah>_5QyT=pk!phAHCM%H&87LPjgH(Jxvx^3}M<Ba%jX
z*U7haW9q9%+EYyQ{{RFX>=g*l7##DO@8+>fdq<w(@f>Tva~uFF6G=9FK4~sW?H?F?
ze*LI)sC5gU4tPdHxsuV0FLHm?D}p*_?_&nOeSLr8C&Vk;dsM!=ktVtkMzMmCERKFa
zNaH7<=i0uPF3Q@Vt5#QUTODf>s3l2s-Tr4i;%^W5hrxQ6k*~!iyoJsiB!=g%X}0>4
zsN5#=B4zo29OKYeqTw2lx<$skl#@*7^{bgR2_(C7^05k_5rt9P{{XLw_D|We?d<+0
zct3H;*?LQ7sN0{=t#nmMVPzjD`5YA&HA#9Nllx3tTg9yEb~C^jI9rkcEs^(g$2~wl
zTvyL_@k?!`BK26Vqzd>T;Hvffx@Wa>VBhXc-m#1FMg{!-ZQ%$A0G_!gsXyWQQ2>oe
zk(i7&KnDO1Ph9c*z3a7TtSM-9e+M*Mty{;DGN~{lZ*mXeUtQeUw30<;h<5OxZ5jNB
z^Y*VBI-RRV3!*i{$KB><Wnpf%c9FyzJa-=5D3)BNHs=_|I#<cb^GUN<>d1toI0#2x
zgmX%zBzzD7#~3FW{Ag=iqP9ZD#f|_O=y~FYkw_o~&#3y<G~2nGT9E}Uk?2Px{<PPW
zsNP8cWZ+}1X$5mBC)87L6-yE^jO20Nv+gcYiDJDvfs7jKjBM<Tb?8%)@e6EcB!i9z
zTBUO!aKxTS$4-5#t_h+Y&lZ+72xG?s1Oe3YGtE}GiBdAh7zFj>uY7-=)tY?|wAjPc
z^BR|DAdt#FmDhYCl}y<xOLYYQ07_W3d_1gG2AuAFIpH#^9Al}#ABA<Xp=JPa$4^@L
z%DPD4#XC)~yp045rFU_Go;z2L{6QFkRNO}y$vsXhTtCE)oVm9rbLL$}-Nv&aZdA5@
zZ05JL*h53Tkmor2xyFA^pUb^{ok@F((CCWQq-q;d0*&2U?+;IU7S)K@nP*eL>C}F`
zMR6z0u59kKM?K<;{XamGOMAPd7bu&=0fB#^^sia{oBlKF7C#HMfu`xBQ@_zQIPOzU
zB*mC!`AJ8{3D4!huDM`-xrKLnHm&nbU(oS$Tufz6QeIyzPjS*d8fqRbus$Zzw5z>8
zQn?;&&Y5=G<VMCz1|N8Ed9M`s@8jJEz!68`pAw|f-MrDuHJl?Z5HKV$<8DTJ^~Xx`
zu$Wm@#loF6s(m)ox0hoaHfv6;CmOQVFTHeU&A$|WFHhrrd0#}+{>NaJt#1@ANo<_u
zn1VU><a<;a4vD4sM@WxU)-8qJw(^PXEduUT8+domQV7lur+$_CPF;qU4uoMRd1?2a
z9yY4QRQGgWr*a!zLsgpLd}XZMo9$O|OMf(ONC<AE9;`P42W({2x*vwM4M*Yx7nzdi
z-Oh}+5)7*}nD5+zPvu^PI9c1s<DV){UB5%wH9JY}Q^vC-(W+VLvWO#r@JhDOI(Gmu
z&%a9fnOWK8mI6@c1-h_qM+Efhc&w|fS(X~jwc6j3Eois5ULWxWnRy;n?B$AFoF3rw
zgY^}?@jBN|J}bRCB+;~YvK!&B;ZbD6Y{#)Jn&*>N)a#6YdCa?iUzy9=yDU=37?+JQ
z2qYZmpX*5ux2Q*8`c1sWmEUurZOU=T;~v$VHJNo5oX4;H4bZJL6p!LX--g^=qZ=JL
z8Oak|Hyglg^v^i=ud+N3r$2@KG<3w%t}b=WPC<F9PUC4gY^-FS-RtJF#H&@5qa|%4
z>1|)$ZS7+kF@&_czp7vGY<hl!rO705&wXgHgdC`C!25kVR(HhDiCSlYG_!LeEc%_!
zQpVIDzJI*KvW}$w72@)8!9hJ);wVoYi&UZ4`e(-8F7Vfhd|M^Yh%WEsxYYF*Ei|k_
zAfAdl1sni9v0fXkcuxDn{v@`CTU?~fLdZcNoSY8z>}A!X3&K0wPm%fsY%+`^O=%UO
z-*}V3b~c}9*JINj;>zO8THQq&eD>$FfH@=l_NxB?3w|5weks)Ld@JB}zM4ym_^u?s
zCF4sqA9(Z}k>A@D>fq$+(@Upck>TT7q0Kqz%l==f`dO;@Uq;k40i|l<JD7#H*_gV6
zk+TH;HSn*AJ{D;H9P!4prPyilHkqh~dug$cDqwdE8u2RQJ(H9o?6>=j_*RVS&Rp@+
zMr!Go8i0ZoxsRJr7EJS!4nJD%bX%Ec3JJ#IGJ5y_06(pG^NO|4&?jXZbUokUmY!#w
z8BjT1Nh7sne$}2Y)HE*##o?_MZzAhgW`&tgK3E?&)2&P)&eUGlJ_`_*BQ%9R+WpGs
zz+NHvRW6&UUD#@q7^J#Ip33Rem3_eO1fKc+b=Z6w@aKqzzo&Rd!|c~E%XepasmbMn
zkO&+&aNUW(9=zAxLbIs_6}7MOv7RC@T+^Sg>-n9R?Pa9tb43)!2+}~uIT+*CzE6&M
z;VBZt0)!yolafi~^TlyssyV@_cRT%$B^rK(d1Z!JnI(;wI0ZJgHk|RE4sq%FiuNyq
zC@g*|{6CGO7?L;MMlqR8iZVd-#d<YkdQx6b@;vt6GxR;9_K$)nyjx__<ffx*Bu+@l
z&zHG>^dtD<zH-+h{?D|tgzi%9E3w<iZ<Rs)Kb>&k@9blsxvv<%FY`F^tt5{tftCbk
zaX9C%9D_yhXx(C(OcgxgM@sZ#@hg!hb)obZ?BU_~lFChFLKHSg$mfiV*SqPlJ<g&e
zF_IIINb6rMn$+jSN%lJFS~To*vO0i4C2`Nw{Qm%2f_GL`P!G-59@XI_w;FE9hkG7L
z$;kj?9sMX$cVh~;80nEt&vMgGKyFYKY>b1`r==-vr-lS$>HO*JCX>*LNsME7QhN*^
z(x8$?Vx&3A86foSTT)2EriE*Zyhb-L+3)M=S+^Hzs7M_;jGWhXIO(y@*HlmwPc!X~
zCUOo&260;&Uxf8dN&f(NN-GXm6}0Ncj9Zb6wb33Z(5nKmzT%@JapZj}jrdfEMjLil
zJvhfh{&=h-z0bGS_GdY(N{)p|Rqh)j81(*C)%+lJYm%G}a-$>;xvIr~yGXh*wL|J3
z3xnmU2PXh~*Jl7OpkVXQHSu+9-OoQ3{q`-~L_q9#`A1XIyno^(07D>Q&cZ+^y=jM&
zaz{p7{rwM{Z^E5kMJhLL1d=oTD|bzZq5#C>?_(Iq^#1_s*Vk5l;yWSnJDXw{kwDzI
zRU8g}pXc7Ve~mX9{)chl?K{HlI{yG_Y2xN-VK^plHJ4~3pimd_H8?0jt|m0<EgkRj
zMmdFAlqjiF?{4Q+@W0?WxwX`_e~330^Y4jfc;#SZ+*>=d)E-W8`r^H_!B-vz@Uop6
z%SN}iwY!AJCgxaI01ueEcHkW2wR;un&b(Y`X&ANmYh&hXM_12(FI^tn`WXKJ6#oEh
z?PI{2OZX$;*|hsoM60Olv!?JHXa!;~_kcVDjCbd)e4V1b_r*O+Rnxptt)%+aw=!H?
z-rUG!mRZ#O-N)1%0qg~L@cvUADtL;o-<HbOw0m2n_h*Y%JdSlEyVd^ym!e*#)`{T1
z2>3%^i%-4Mb)A320&S7nh`fkH4&<DZ&wiE8d{FULqI^Xrm88IyMg=il7y$vM$;b?P
zfz#ZE^{=Iqak7fC{7j)KN?N{~8a@@Zdp$G5U`~^z^!J}>ECVXK2*PrDa@~FFr|_nr
zgT|KnecKZ@n{c!FTYz1pcE?eIPJ0~H#?N2tVrosw5|3SfQ_*bfH2oO(+WqD?HrICX
z!)+Rmn5Z$v;0~mmG5l-5z9M)+FATtMZlX4E-rYa;b+{wUnlR^luBVVOfCu?F;v;*$
zpV#~YJS|5VwD)#P<rRO_;hnBt<*wx{6U@&-tGN9?&lPyzG8rXhS7{W)8Tx_vbgwz9
z9?X5`=vTOCY~XNWLS#}G0ORSA$0I$xITdT+zl8N49(c~fLet|rU5A|^<V6ts&7RzJ
z`u;U8ud=5qucB;;N1dp?r`;b4JT;<fz9l-0wy1nJ;K<f1D7FA6xF5&vNgtrEZqRhb
zyuP@-nMjiALhcVvPfx<W6A?F7QBT$U%`*vm2~I2Qr5~Q}@v#@he~J1p!#y2LjI-)D
zd5+4=HX2swSo$FDe+v1|-hFGu7t?F{{n5I<x^2bV?yBd6LHr<gr0*$RdN1qx>UVIi
z0@US=sI_`8PQTZY&}mw7+RY-E!CYZL>N&_ik<DfJr@*>rh$9l4NZR2T1S~lRJ!#UM
zsmqx&>T23=Q!d*}zVO__!d3fhQx<1g&|*0F`9bUX=lnZg0DM4S57<5SpW&pm06BQ#
z3R%LEGBb|2HQKQiTwE#2$=gewc42^{i>J*~f57kb{{W2-;&gpFTN}GuVQiB;zbful
zI3N+9QPQ~&7I=3?lF??5Rd!U9&R7D1N%uW-&-1Qol%o}S-O2g?0KiD%%V9jaud}3+
zk5{h$0N0VhJU?r>^I%=195EyO<o^JTYH4nw?k(kTPb>X%+PQgLY<+ua#ih}Hhti)0
zZc)lY00gdZ2OgEne$n0sv+-u75WmzWwHDEqiK7`A&U5)z)VX76$zI3jQ<UiEH;(pu
zo+)>sX?A*KwtDr*)nK+<MdmJF1FnB6v8H@T@ZW&68>Z0wHzZCWEb9%j<$xe#IT=0u
z>({4_sVZ)jCGNdCU(?X_F*$52+EdeQFQ=}@f_zf(?!ECgS2k8J0%1urVMs&BDhIKz
zIM;MrZ7Sm4B!4ingS-Qi+cmZo`x{e})!ye_T53shZ53k%+(9v%1a1Cms5@{7!Qkh=
zOjo1$E=INZso>b2G#*K`jQrf>F$eXpYF3i6?Ee5G=d9x<kD~toX}c}jeu?5QC;mO*
zj%Me8c92iE1NE<#{vbF@hO~0biv(>FE;1W#2`3(>KaF|V2HiL&Drs`*(*FRN#fap2
zB8<6ab|-6b$I~6Z!nEzQ==E)8+fHfZ2=1}SV^GWiJp!C^J;=^0&~DECgI60P>raQ8
zGWc`CmiC4=2WsP<NWiZ~@ZGb=0k~nwILSPp@+;%<vr?R;-JMpnEQ{>i6=HXNITc-*
z%9HnwNyd9un3B0mVUalnRzt`=!K+tN+sN@WJIn3Fgp3W|-{-w(($x^|+*u5ADNq9(
z_ayOAO65Tz$sIW8X<6SwlUKP)YnBn@6W1GiRVnWS4X(p^7$ZMg>7^Y=p2cLENdZJs
z&QAjw{{SNutE6}<P}L*`;xdu?4y5~<-mPfiqULiq-1H3_z_xaXq`<smBNfwHX;!w5
z0EltVO8L6@$<}+AH_;ysT;2$V!p;5DgO7U0zrO%%Kf*FN1XtBlj=Cf5r+eyi+Qs8T
z2Gs!ZkPBe_KhLdoKLxJdTjG+9tWHS>ImJ9wZ-teLpzT)d`oqGGL@F_p!Ryo0`qyu4
z2~fkR!hm@KzAF%}^f+;PO_JP`<S-q%BOD$p$bKN;!6{&V=^TA2Qg)S&jJM-HV${KH
zZQ08W#~l9vcR&4a*0=PcNWjP#I2*Y>-{;o8x~umWq3A_7E3J*z^GXHW*aJLt_3K@a
zgReA}wT92c7SV;aV<b0HLam6;-cz2rBO}}z#)7EkoHt+aSNsz^d@0n!xc>m3>D+IN
z{v+smOjF)y8gy370Z8tpkIa%*JOxBQUr$=_iJ|cZv3D<sd{6e<J9xpA&u~~gia|RU
zJ-vs$eSTYpn~SSgR<!b7hsR^2smVn>U*qNJ{WH%zW2{T!4N4<uHbUwVQyX@!NAUCq
z@#l=z&Xe%_Sd&~Sq!vl6V2)IgzEHAoOJ}#uo@?Ks3ngRCoRylE-|)w?-TX+8L6c0=
z{70rPqpv-(#<!5f8RiVx8R>#Ye?l{g@?VS|BDY;u9V!hv*4^P|n21U93$Vf5anCux
z`qtGd$;Cw+7-}w@?%%umbo|WU2}P;hczLw@cqEcb0WHjI2_iB=?oda527em#?+IB!
z@fBv)JUG!>c!~>Ew7!aCv?`J^>yP(O(?0c3+Rsnw=9q~_n&x{g&CM&t&7fa@!Z)Zi
zTBBH7yUege9o@1OBVNBbZGinr^{+4Z#IjrXp5EieR(BC=_ZDd^kVA2mwFLg{4nYV?
zh9yAmJ!=d@ZC`cM`uoVC7)HA8)}EbzM0ucTW8Whw>I*giKi~yE+^mZ6;AL{l$j2Gu
zpQU-$ZJy2fQ!8pwT*!(E-ShMyj^CwyCGcOu2jS0vhNUgJI`@i4mjVU(qP9GK8Og`g
z`d6Er&C<gvOL@C|maN+@jByx+eUbH_fqWSbi{ZULNQNzvL`2s_jPIC^LHck$xvq=H
z-Z=2z!LJ5fc&}ZMJg!W3mdL|>%;aTbU&xYs44U~B%_+NX^k0$Y<L4}0Wkwsx{%`b0
z$BV1${{RrR`Fv;MnZ);(3<}1%*#dtIXgeq$=bH3w3MGy>%SH$o00Dxd2LRPd(U&Ud
zewRjsaM)<lhKVa3oEDMDxI`PXf=^#cy(WPirDS4vvC5J7{{WxHq3X3bCsDzbu6!+Y
z((aiP4xvLZ2Z~D{1u4n$(+WOi+4@tBm8{I?jf#V@v1y=L*sO6z6FWkI#?@a#S-RX7
z_Er)~sJ?8xDb99+Pvz3JbrVM=IXaU`bvT=Q0R$~Gpk3tm&Pg>yZb<`>K~sPi)BOJc
zD#gh;A5%uo=g|KE2QFAVC3><i&7VQv71w-A)1khYG|C8Q_&u}!f1Pfv%X9NA(oPwt
zGCU(+@cpaG>hSC!k&*@vrEvPrl*=U0?NE%nNyl$rt!K?8vp&-YQB{IW;HU7trL4^0
zHc~Mb>=W{-<Dc`=yszRlgjV;kleYmMX~7x5z~>d)gmRTwwq7O*5tWZP((M6|qYgyQ
z=bmsl&*@#ag|6d|;#Y+vX-hbo*fvjdD9>KKN9$iyq`8{%f06Q)Q{4LJ_J+23z8HDr
zW;iS*1hVG@Hy@!j@n?!<7aEnEW>G84X#+7Ic!IkK_vjDh-n{Gvl$VvvY3mp2%pEoW
zEJ4%0XrsJ0D-L{>#tGaH%UvhJ%{onQ#}=gSD2`l=6M^aN)bz!7RhKH9yCK0g(e?3x
zBoNxBc-px4{{T6z+Sv>ivBFdgE^tPFU&g*G5$`QdscewR2u5P$HsgXbj2eN7Ez5oG
zyw(d{g|ZiMICah#<X}`_jl}~K-{s@*r@OlnwXB3Ps62z8@_)jsNi!)d%sJ$G{#9x^
z2{m?#Q%DtYAsazFbjP((j9p*ct+k{<q-Ftqx_*__PRVmK88n+cJHg)%BS5zop_)Pg
zB=$bl-`i;x)-i=d7#Qd)=CdqkwwqDd<ec24Vn^Bs%YZ!vFs|kVkIuZ*?t<E%p62Ek
zh08RB*92vTF`j>?O3IdXkz5VO0Fq07zny-I7&Lu@lapsZtV+^GPU3dtoHly?71{h2
zV<qU2$U#=%XEb8s{;MWwLRPGi^|yqS2vtZq00Wcw*J}X*IpYI9oN-?XTXUNd?>m!S
z9Kg)YfJSn7&3PZh62{h6&fk@WbDn;cICbwMqc3Zi`GZxEHn8kN5F4tFNanf?5(~TO
z1UBf!*npwGmp@ATHx6|b=yoY6-cMz7zta3Yr9y$V&1qws?yMH;y~*^?L0ePXcn;As
zeFgNk*1$^byeK~SAIpmNa@b+%-O`Udmwgw@x#8w`j8yFyH3+`1SM%&}o-+95U^Q4Y
zj|cb`&Q`RIRd27ND2j4V1CE*Mc_+1bm&8wqo*?mM!L!t7iD8XFl@c(Kt98Ip&l&1Z
z<zGul)b?>x)64wNl5{2Q-Aa#{{vRU)Lee3-zk+!!)gZK#OLI9~C`IZ+6YGJ+ddG(1
z)bAfr)b#y4Tt2HZM{OGosK_}iM`Tfq`s7z-D7#saikeZ?{{UCN=v48g_L1=VI5ms8
z67yWRibRHG8<7YnEzeK9G1Jsn&l<a5>N=F#rRBoQbvy5JIxn|9Kl;_rR;A^p#ZXRh
z=WBn-9VddkX{vZ%Q4(7|+h@<65dp&jIri`W0P3$y)3q-G%Pe;q#_cNN=5Y46Q8AGu
z`Gy8me-A>Zk&gAGYeq3{dZAW?n{GS)WsPU!rj_7LR(&f=@YR;DuP+O%%7P+T5>)IX
z<|8~2j@6+501xbZP2os<X|2v?)-PDie>KArT0%)->^%o;3i9(TbiJHrp8I+im*Dv-
z%B1z_=(;1qHOQ^(wVSxDOp9*A_ekR$W3N4q3HnxGA|gt;2Y?G;eF^lfAg^Zo9aSZ(
zM`!SJ!B6Aw9a&l31#K?cL34W{1S-b7<lu3i@#|k={5sN`#U4CueppD;w5ZhC!WZNi
z`C?zhoS&hup3iEptSJ8gByaP7@DbI5e#;M5r*&oX(E1KG(!4jLUF+KI{8rW)bWe48
zaU%er0l1QXI{fnZnem@h`1SEI^)RwQq1ZdYq*^mzBw7399yhi!e*xQ{D=(wX%~zyX
z;{O2PT;<8*?eYH7TQBSS^*s;6Hf;r*1TF|1^Zfm5wbDpaw2%e>Bh-#Rt#CQ6YoDhz
zcpavlCeWxbagfAy?cTbJG+AO$*d<0#o|vd?@iA)JnymnMk^H^ja#fFP_M~fAlo1Pr
z$iT-UnrSOD$L4EdH;O1A+~IOZQgTmU%DEkR1g!XN>Pcqw0-K%Ayc%wN$1{6x8r$qr
z8*fJFdVlq+pO!JS5cn87vGoKDeiWqB*!p}ccDp^V;GNSOnBpf2!;{?dE7txXL|;!?
z)j3ocBzLZ){{VK+&NI}bny)j(HO5=DZVIp@?%?Mh)xc`1$ukDY9WqWj*FLg(pIMb8
zqsntvu&bl8jz}OV^u{a0{w|2(yn+=mg3LyDVBj3}{42WvzuIDs?0V&<+2)!|2=S|9
znXXkffz)o~Wcu;#&1fX;XYm6;naC#EYcaP2k@Au~M_T&G>s9(c$oTm;%C3FY@jA@w
z{{RlJG<e@HCZ9COxWW2<Rr&LKc!yWEd8JlZ?L-B3frEqV{@1m6nQOcxyFbjz3fD-j
z8~IjGE0S58Zv>2Ew@UWE*|S29dyAc3NWlSsPn2{Y{d(%hPnQol6-qXhk@RkpY;JW`
zE;6V$anPSi>gNP5(0ITHpJQJeS+>$OsbtbcSrv*iGK0{7PZ+3=E0Cc;<df;1{{V@i
zDRd_7s|^mM7AuSqfDUR0a;(5`2>uiF>rTnLF=~+uzsgy`B#e&rPT`s*!i6Anlg)1x
za(TM5J>1PGhBab%01EXl0C+JiqD#w|^COMKpIYb4Yb-SmUaZ2Sy1G3!-6Db@h@cut
z^5lX#b>_Z4Q@eLLlC#vP@t15Kc>Jo&R&K-)qZswA=|Rg>Da|B)W=(Vn$^(pGfHsgb
z{{YvjvP~>tx-JP^9(sR;ewd)%ht~T=+{e`}QKBV+;{<Yl&o$h96p>D-2n6rs?K#IM
z^{nyA*jXc7AH7*0UHDPiBSmH);0)ux^{&b()JMICBn~}Id=+@|$(iD==X5^ea?!DG
zs5$N0ysO8`8rpEp$p<;;Fb|=nMWrR`bmi*OX&*3ZjvHNaN|L7oamIP=>(;t0DW$el
zXN{u{GOPvzeGhM5E9~4KvrgM1S1)<TxzSi$1Z8z6<-r@9zxn=kS5VOWOXE#)^jajg
zT4lAed6$m+5H?TBr@lv1>0X9IPF1V9JtDPi;Loa4!{L3T-n%cE&T5uWE%){om#Keh
z-;hn!<N$dvMyKWqdCPD{eQO5$!FC$gh%Q#j=v(QUbgd=b#N=&O>+?54eZId+`s=Ap
zHL>zgpDiaj=-*G!$MH{zAfC(q5$_AxG<sB06LC2Mb-`bou;6^T$F+Kgg}g~^d+_25
zy%I?+*H4|TuhbAEk|WOi_Q?l<T`BWH^CQf!7s{LJ_5D9X$9zi@*e;{tsUml{v%P5x
z%5$BowFnu=1U5;}I9y|z<YTvU8{J*yh#)ZS^8?SXV_X$<cI<j|b%pzk-4tr-gyKZc
za&SjK=lRyXyqc?cetE3+zMW(c+_4}akh$8(2+r<DPp3gyHrn37CuW=KXLyyZwQYXa
zQ;tTC*6k8$9aAhD7;Zb9=ku?syeX;aFzNa}i>~ea4yAUBEX;>sEUULCup|uo6YE|!
zHvYmId?~-Xq3Oa7PHGQVx7>KA?G5nb#9j>XWcrNu!d*K3%!xkGL|uYpXKn^7$OYBI
ztce)Okd8+}27k{r=-_I`y$DoH;HZ<Ek8|q3gWel|1N=C)je?C^#DmV4a(u~dF|>PU
zKhD0!_*vlh(EKZ7r<+~3Hvw;MNgRn8ent8!k;l2Okj7W~&03Wc-Tn*y80yR))o@UY
z((eBNB){R0mHz;4FO8z=_CJBX7}OZs+eou(QpKO&Tx1l3BdV_ij2>`0gI_=VK88De
zU_j@0mmxq&`G+{;*w?Q{g2Uy@ytV%TFTkE3PueE>>-YZvRz8W**fqRNtGEsd<DP?`
ze)ZDW#u2wbPUd29{ob9c<z)5L{Uv-SPhl*=HB@e=aV_hb>GZ4jh={_HNdTVJ4*d@+
z7fv!w9WABUk}sGLLX(5}e=$;CNUtB5pds6a+CH4qyRt`tDt4)%n|*LnHrmW`xXC>|
zze?mai>Fq=8-O`2=qotCc=WJz_0+?;yb?j4ha|8*zvS0GXY($y<0?9Sy#D|{(zI_|
z9_<L(Gu1v6Uq@qqZzI1M1FkST;=S|6;M{m-ON{4gZuiA^L*Quq^NAwXVNR!+;J5Nd
zs$EWV$vDUdwQ?G?Wze`BF~Xd6Jb#UI#ottYK3?2fY~`<?V0I%M`kuzVaQL^WAl4YO
zXUbivmB}o7ena%HM=OUmD(7x#K3WXobde#svxmxKu&&|<LV54?r}(Dp$nnvXH_H{u
zFaYt4k59tBrW)3_lRi;dMJMEbf=rN2W1!tTnIfLTNbp8@bW`(wM!!6~X{Ek{<2_4F
zxP`xSdn_nN0|HF&JB&AK^D?H~=N~WgIr*&{{{US_YVj*vzm&)~u#<)06X{=2{14E7
zu)G~_D-f?T<nih<f6vmRHj|DTG49TsJ)3Oye+lX7Ev(vsnlOHEmChJ}i~;M$e<SUi
zH#w1s4UCWn7_XJ7@z{p>rrTQ($VLDSk(#XJt78YJ-6M}$(mp`8A!#>YDLsk7sNQ7^
zz=MJU=N$h4I@;D+3hwEUw2Tmfg9nk*jC8Ea+k&TQ3)84L9cyT9Vjky3@aw};>X-ij
zZ=G`(Z;+At*ST5SM{8~sS09f``Mm18m0m^A#;&a-JTTq2cYc*3MrC2ObM>zp7n4>n
zpSrHgkm=wJ%zr;hv|^4vgB(|-Mm)B;=hUd>vH4#rjP3xcb->8SZ(6T#=#jFlgn*#!
zIp@88l?ya|gxkH2b61&+MSRRRBbM#?S9|a(Xyv{tqjMHHV0iEP)_IEm0A!Vpj1TeA
z_6LPayhy?Go`p_ptzubJ@^~G&2ep2CRV%h>iC+0F!4GP|QyYN%>&tw03R_MwfwYsx
zYZ?~k)a%Q%c0N|uB!BIh-y2Ts@ty%Z{{WNiUafDXw~IVCq+Dqiae-*QMbt!q(dQpN
zI+0(YQE-$LChVI0cVBsqCHpx>s@gAKOIYdbX7HYaGTCW%@amV`i7zhBB8=nsSF3;Z
ztH(Yt_=CmXCh^6;hb=XBwbR-(M2I<x2WDUaDm@9WZwF2>l7d!>SGT8E-Tp_<;_1}H
z%i7k}^z6MqR&_S9Xnq3Ff8h$UQ8uM|zE#!gf6Kf`F!B#xcmut8kBx8jYx^5N4rx#e
zT^>mr?6Acuw3jk`qt2MACp`DyWRAwYdP|;Hdo#qFPD=j()9Lpw%-8<_gm%`)!P7?4
zn43kikjXlxeEZ3nS7<zEYG<E7E7N=-qFUMbTFb$<7K+ywx@?nO$N}8bGM5J)pf)=8
zuSq4!(mcBLXJyRxZT-ss0IB3(72twsbUzwNbrMaeS({to83l#Szsf<u&Pdv8&$SuR
z?51mFV2>17ZcgF{C!eqDUOiW->|wqHyIp<G-=WUhJ>A9J2%$?mDa?!qPjg<U;C~5e
z*WMMrk@Xd6BO+I}l;D)WISbH^pOty|`m&`)@m*2qVCcrBOH5A*ctt!(t;sBUbFHFn
zTSjn1L4g~|#|Ip6J!|S+N8#R!uY3-<yVCDg;%Fg|iDEfEaxnxPbUbwWSCg35_E4u6
zz1Q8l``_esxjJ)<qO?xmH+A`6@H__N;`O$>@E2O}=ZYR1i@4?65u6s3&e`OB3XJxz
zAoxS!TaO?3?@rL>c3UwZn(@Ku5}dI=%ki$PBo<$XuP?Hkn*RWRa@Y6kMa63M{ExXl
zA9!{z8hk*siYs0Eb&8c#1BHS!g$Ir^#~$_Sf3%;+jXU5!fh5#z%u@J^RNn@bYq(^-
zIhBX^6C>(yJMr^$=}xqvMmx*;{53f<x9uy_!@i4O*YHQ>rM>n3wc>TubxW3-?*8}A
zxRypGq><k&N$yEJ{cF;6s3x)TJ=z?qdF;Czj!DSJ>0eKn+7M7%SoU&wrBdwo9}X69
zs*ZXPr$6V~y31JuV8%1JfDb}H&MV?-YR|fk$3v$~;r8c{GD+xoJXb?$JV#*!V3I-U
zOQFGujoyaUrlQcfibo|%<0Sn#t7~>7O|Id$4Cl5p{OdcVvEx*yXLM7$m`JS3GB)S$
zah{dLc!E`Ll~@1?&UvZU_dBp^(nmh?ksF015=bB(NUWxmi-1&|00;;CYgUhHl1TJ#
zhc}9ssVvQ$k<@hNzM+m4*8C$VAZ>V=2jyL~ozeN{7AFeOso9@6-pT?5^7gPSgcF`Y
z#d7+QA#=MJ2O00pVH>AreJ%>t(Bw7irM0zrTb3F5PuD+%e4*pLLG=$3OB8O|4oi@u
z*QR@MUfx9qD)N_PMte0JKPu`?qD373O~@>avODAZ*c^W&SiU!CTgGxYL;KSU3;+lv
z6y*LUz1lDRrru2O8nrafy?iZjb)N$GV)V$tcEuCq;~S8m{D~Fu&&P{qwD_#nsSznK
z6SySuSPbW%_DAJjW?N|2l3kh2RkiNE{{XN26PVDgAH+T*)9n@_V|m6-FmMSyzt39x
zPe`&`4I<Xf4<a$Z>6{D-!#tI}oI4$OU1HhaSV#72C}C01V<V?be>#eJQDoRxmgEfN
zes%J<yxS#4?U2Y9ZZNqd@tg{-$Pdl|$8fdN2X(0q>teZ3L1Ir_lkZTr<$b}rkIZrD
zTcR(03U4D2<Q2ymIl%R*a9c~MU&m`2u-@1>?OP|y7W)Q{R%gBVH$sa`)1y^D2vL)Y
z=p;Li)n5JU;PF#+YPmLZx9>JO2wGPP4}Z*7#kG>hg2J@J)3&VQ#MHKhwhALEqoAsd
z9E~Rg@^fC2O|;G!v+~~J7b~^#u#vz$eYvdrg^n=ARf`@8Q_pev;=e(R?2o&gdA2zX
zY)UgEiOS$|4<kK4U)H;ifGsO(PD<o%Y_at8&*e)V?}L*@xHO}POUU~_!U3AvJoNwp
zitM5rR{&#zIqP4aRMpv+inp|6vZDQ+w`3f8_OC7Yf}mSUfUY`nYo3z#(bbnfe&@?N
zot@q9h@RTY&E+j7Fc7ip*1Z!-@Y(Ryq&GUwpz%t;6|{-SaxtI7iv1FmB^q(5Q*X_g
zR-5PKj{g9cnXjj6vmugKwS|);p=9}!*fn`3wR*b$0FMr(dKWOvR?$Z*lo`up5!Fvm
zPpx~n3e&GXXW3ikc$nNgaPfSvcFpLaxc<Ps@gBOR?kA8#XrILK?>jg=f^n1W&!utK
zdYb9R?)hSdYx#mCvY-WGQa};Lqd39GKK1WYl8aGi&q~s5^u50$W5?Qs&xWAz_km%#
zR+3nmwJ8}x12o%7AMg-H3C=TKpYZ-;rhHF*B6)X))2*a{6O4_ZFdq9)O4k1XyOrPd
zvE^4vR9o(w``Y~v8}XismzsBt{4_TkuMg^DR=4>`K3P6o!;XUvhw!gEv(uR%OS|_L
z)}&%Xjm;s>aHFum>;C}iuRgR^t)9IHt82gJll@HlozPv|nC;dWZV5!1MJ2Xm0>_S(
z?0yu|ZuPw-ua3Q=Slem3bECAABvM>T18g5RBr+xe=LhRvUNXEX(dM4sUZ<f-FP${C
zM}6U+5%@!0@I|JD;cpNd8`}WV%MHb+n6DwoVvLzQ0KIY3HRM{i#EX9n=y!S_hx|jW
zrS-+bHPKnx2p^NcjC361p19_`Y$g_UD$QbG+r9PGTcy8V+a1`N(NvW<TX%bFf0sx8
zS{`esTIw3@-LHo<$b`50y~;%r1Ic!50rfdQg?)M8kAPaQ!u>vby)q=d)o(2XR}w;d
zXD$?DrU?TcmDik9jXDaA?a%ofSZazj)TXYIJ+t8+p{e+DLDY?(hvl`^CStN(-Ka}=
zP-kx><-Kw2E8-v8gU1)XJovSFeKxw<kJ!>XI2BQRw2f3`CK&F?EPHZIdHGc&v9gq%
z+FDzuoAdH8s~F-d&bs^hbkomc&%8GPJ|fdgZ71!pg197*NI3@>!0DX#73+GXyIJ_Y
zd|(NkS}+e7#xvL2y$sE_Z$sP4Y^t-=d@~$|+8{~G;NiJH<oZ`%YazmtK2k{s+P*fX
z`X6lz*xIoqu*8@d3|Fw={{Z#tZrWsVwB#NYKs~WjeGYo)zi!SzW+13I`Hnu7eksXA
z9ysbp`SzsVmPeOWE0y&LfP}IJ3&_C773cmhzLL`1GQ!z+E6L}tN@;3z;ML@lA<^xm
zdr@;MWtehErr+qsI6T#Spur%Hl--X@o0fJ+=)4Pe6W>Q1Y;Z^nNyaPdF9lB!@T8W~
z$_pxz0raiu)QV2$!*PW-%N;ekK5W*mSnFDfMspJ0Oc#!R`R`oDvvLa;P;jGf;pzT;
z>SEtR-oZg~$I%{N@i$(JNbvp4^EPm&U<VA%&OZwIT_!h|&vi4i83}So=daU&(!Qr6
zr^`xJA6*Y8J*&-9G}lc|yTj);NM>MIAt`_d%y=ESKhC+I7AsAy!s@$<N+T=>%t+hU
z{PwQOU+*oiGl|>TBkhlX+LP<w2{ifIL%P~v*e5tB>~YV!kIuX&_Nvk??YvKItlJ<P
ztywppRXJ7ZkVt0zE6u|G?;7H~(alowa(-tu`#NZ=u6T{*VZ2(H<;LE5$Ulca%D%md
z)n4k}6es3!f&MkapHKa%L&)sHU)ZS~EYE?3Q}T{E6-st0K|N1K1avjwB%1Xyi3yR$
z84pZ?F`7vo9kC;Uka<y$^VYSGWG8LN$oaOCPH;{~Ph(ZwDP73QtO&s8k%R5)TP+=o
z`drGrm7`Z69E=l#$K#soz8C01>i6xkqhoOZp2DLWKV^oLhbt(yk84=c7*!Bs10-UR
zW8C-v<d3c^;upO;vy)|WV#e7bK+L12YQ(Y}5C=|%y%;ALq>nD6=AGDxS%ya^xu-B4
zamP%G?xe1ccI?l}`R8|Jl!3c~FgVE1YNc`!qa}*-kQ9zGf1Q28(ESlpO<f%Q?Tg$*
z=*kEq7(Myvk6QG<ftm?{!xPbo<EJL49Y6MIK+_E$-*a|8t?<+hZx}()DDPcVU=X2>
zN$drDMMRU(j6=NcTWtNDfDTCYuQ2iYsaXrQLCNIz<3Gx>p`}HAu5@5NJr9~St$R_j
z)?~NR?i$=aRoO@k{P#U-?w>8q%lY?GOCvDJXE|a{d)M1lsHILVb~J@G8jkz3rF)x;
zEfVe05aA(nk`Es#=Oe#=@vk+tvPiY)Z>B0HHf?a|8|6Ysz{mUu=Zx3UWi7@DzNd+r
zCCx7_y?>^3n*P6_4+dK*-fz5lTufMPR3S!HbLcz%70i4O(brSgH9sHg_Db3%k{IBQ
zaxpC6e(inmKx3b8TK6c*PnvCiU+_<r#a^8k7`<Mfd;JWr7Np)Lvb*tp`0`{rjB&0(
zE)yrraz3Y^^!Be-(B>=RUkvz?Xtv00pm5~yz(z|Byyq3w6uCKHW1hNS3fj#ZJ|fXA
z?fyMQdu3-A_Fs-PX`^t<^0P@7L!b7-<Bq1jRkxE*w%29RwT6*nwz-}ORY`4xF&P8%
z$I`so?b_*UYyJi0^1D~-82$RE`5S&A@SeS@cuLd78g7{KX!>)!Uuhr>`=lUewnypf
zT;+zf1;L9-*Ayff2(rSzJY$@9=dViQ!Z_87gV&X`{{TB4rGIvO$FW`6cxT~n!jp9k
z)Rvwz)TMQ|nOvXrL$rn}PZ=5Jyms!xRMcmZ{{5xBxt)P#RW9t$(>Up#X)lgalIqg*
z{=XqX^HaQC)4TK2L)8BOWzPi8pA_vpW8#}8x3tog<%MTZ470E(pntoPe*s^hnl!#2
zy@DhcF)L*6S8>w-51{MCe9nD{i^M3cVv=9i-b<lbCsHW+bN0FYq3*N`{{Z+_{sq+F
zkg}|o_i)Is<?_SH7#uelJ;xm@<FjvhCD+>TBz9&Y+1&DSdiCbLJgW^F7=LNjTAI@4
zbkdhyO^pIFd`+daIbrt5Kny_&3ojo1YufdVHZ}2FVbpGT_X1P`2`q8+sLfrXpONn6
zKkpXxJG}vAhA5*TXPvk_^~d@AYo)bkVYS=l2RJ`~#e8g==DI%K5wg2CESQv31x9%!
z^dx`!t7_bZI3)bQZESSF{{SML-Hux2q;xH{3Wib--o^!AiI*o2^K!g;3U|`yol!8k
zK=DWlg4o7C8shv_rW>0=;aU8)4hBf%U{MFHio(f8X};$#;u*EuoeAx{D>7SOu);g2
zAw76K>zvV|_@}1nh4sBc3)ui5s~}u1dSni3N>QTezi9pY{vL;;HC0tsSC8s+ei_!T
z(&1z_uWKlfE1)^Z&jfnc)0#(#ub}XH%8Miu%^ujyg9Hxdm$Q^^-rdg&h^fN0I(OZ(
z%XI`6^GL*(Qc2zFNzXOSYO`+}e82|WoM4O&YSPm~qYZ9Ue7*6*#IkDo;Lz<R%r>BJ
z!9O#e-<R{RH?ogpvVfT}$AUBN2Vcg%>n*43aFJeD`_Gchs;aoAud&wI+q61Ll}83i
zBaMoZNW&6%{41W<;1X)L${P%hX9qvs86TZ<Q<L_s{{USMsV{QN$oil5Gu77fz<Q3D
z#BQ^mQ;xlGN7MMfI^%z7>p368x@M@+ub7julm_SJVuXAD01xS0n`TXU{$~raPT$sy
zx%)8qPCYip>sQ)HxH(5T$wCG?_x}Lv*U&m-d#{>Zyegbv_pb*vtL<^JYoX{uDxC{?
zBSPVr^S9Um$2Cq?-be+4fO;Oa#TKk`rPydL$L0eW&my9coz4RgdXfhOR>@dR#gM#`
zDs2Gpa6YvJ$0}8hNgSMDdeuisXe(V=8CQyAkVL!!+gAg>rF(C~tt?t;kpeNa0q=_8
z&T1%O)O(6w18nUbL!O`geroNFrU7y~de_TQi<GrEYRi@uE{NCxw~CTDgOUmB-`>4y
zani??IS*LXdSGDnrpbcaRGR5d+8EilbMlr~5rjbT?<9eollg(~QOc0V83mP@iTQ%{
z>-ksOE{!wvn902vnQtY$S1Sf`&w@$q{&8OG@S?>bV0Pd$1DtR(Sz~{PWK|Z_n?3hN
zRY=r-4+l6tmAP&ih|3Y5*1j^kw6r33ZtT-Q>jQ8Ck<Kg3{CI@LF;*OcGupAGetiw_
zEqhH*l{`il`+du|@%KGJ?fF)|nZF1Z9FdX;>&VCQue5P)oK3lxwP&H}x*ztog+0cn
zDq2{>0mOuW3HJKe&i)#kQcoD_Lh9$uQYKK+5KckQIXqx??TY$5nO#XseGdaTlE1oZ
zS$Gpw@%7EL4Jz8{O*2b%a9iY#Fj<^~+@7C^sQh)~NW_-D5%9Ev-$Ak48VrSLKsYSN
zzDWHm-D{T6PtBh<IVn}LS})K37_}9}mZ5mCY7VV$J+zVGSbwh|fW&keED8Sr^;e^5
zmfC!}hMbVxi-V%uqDGG3l6D+t(<Bl3S6pP3nmI8%$=NLuXGP(CVRd~6PQBKf%b!Em
z=F`I{%f}p}E6<=~$I`qr;}?LgbYF=#dbNx|+iGsoFi<{6IS<BpImxa(L|(C8e}fDg
z<-~HWzu@2XJtN^?iS+*f5Bw*-@Rx}6sBXNOUO{Z^0}?X%9kK}r9r5kQ&lWl@o{g)&
zh&82YY;ETfi)UaOcO!5{8Q^EGdjnrTmr|Y|6<$wiG}o_R>(uwL>CTK?UcZ-_>RuP{
zhO6<LPn%fRWRa2!fWQd093S~)jnB#e91ivLC&SNz9(1cFtrSsOkOPng=TXqNrZ5NN
zQJ7*KB;zNy;$s?+p-s*!TO8Mjb&VHU@lt5M4M;5Pp_#2M9Z$_U-G`i>`-s5y=DWWi
z_}5SUoc<C|Jk!B(<9`$=i%yPb4%X3;%;Xcs-rlXWb~WL`oT|<-zr7~DORwCMHOw5L
zhNp&-cazu7+Q0HX3;xcQ>QC(pi<Y>V+`F-5c4M59dC5I%cI)l;x_VpAW@L@FoF+0b
zI5_Lmk4$#2t*VrL*z99XDKzA@PpM18mhBgbH1W1?EA3D_qaiAAz;mCad*_Iul6`g?
zgi=s33zfk8h;jMn^RFW{i{)O2x0OkKX>4`6R7K-f3PuP#f1WF9-DOf3AtR7T>;C}P
zua2BrXWd3gtxa1vq-5#{<Yye8de)9&pecWxa6XvDEv#c&(k@#uknK>spS_>PwBsrr
zn>$N&IIFg&oma78uvB5PHi5gp{{X79?xKQJATN9{Khx_;Bc3g%bYNd-@JQ<DfH24e
z40ih0OX0tUgI=(>6PDVsk_c?`jwrNb)`vzbGI&fsI_P!(01dnyquAR{XVRc)qR!WJ
z1-LlxTHY`V4YH7>S05^l1$0!Lrxc#Z`5M)wUomo%zx*-fI+W#u<L29t#QImAc>BaL
zcyGh^nyt%udm}pmKY5Sc9{kpnsk*aN`?KkJy^SX)(D@4XdG9YDP?ldZS)HVjiNPnX
zYQ~Lf_YWZ;;Ug~RIV+96o~FM3NkW~G@d|FGMJK(^;@UW4(llsf0aoT#m4gmc?%{__
z3goq0Rk)J!b{UbvMx?h>yk|dvKb?5=o$5E|`kuSGgSqX0u}-PvYx>@X-zwcII)?5!
z2l<NH`0HnJd!i<m%Ghyzv|}SHDv*B_6^0|+%p9MS{0?Z^Q{{ba`klAJjT8P6?*!Oc
zvXywE5wR!J{F?MFF+_07BCayn=bk>b@_3p1Ohn|no%K?UB@{~|Fa)sxfIeZK)mV^J
zkOu9&$28)tp~juaNhN+k`S+$s;EkCifxDBQ-{+-lmC-#&oiLaKfI1H5s>;Dwge6a*
zt4;37wzfq*E+coU!5JhS;GF$?*U<hQfI+6lp?3VEt$3O2?HI&U_*KoTSj>zGPB=BO
z9DZ77rfbK;D=VH}CQAIHOAopazG`^LUWAN}wce$7p~E%Yb_)-esW}*-ApnLZy6ML9
zyD)Cb$K;F5o7d)2M+4^0bNT-Okx`462*3a{^8!gdyVu)tv-F6xky6SflJ#T^Ffo!x
z%hdYU&_4=pl-r`LWqx768Rr#_F?*IngHB(0?>a*h7{K=#^sU$svjR!RdSbpS5p_EX
zPpP7SyagF?)Mq&6yxYg<e$Oe#ARaP7^sZ`pRI$DV-lm7izA2E85WH&pah&wW*1Ep}
z=yL0KN6f-mTaPm0XFMv5XPo_O?&!mw5x-<>Qlg^eG<JHfu^y>mc5Ro*({$(x!3%$T
z2j*{6fK7OJgtVXSd+)X1%#cTP3XRGY=4WB@s2rX+&pm7DGKQrYK8c?>n8%Xb+uG&t
zjD9G(hW^XK9vr%k*Gsjt{{Tpi9u?S*jgGtz)Ylnxqgmb+yRkl5xC<)6*xZV$0m&HZ
zbB>&1y-3Bmb6-=zigAQr&He_xv~%7q+Qv4tQl-QUN6RAc7z6BfpU>X9F9+*T4REc%
z0xQ)kBNLLOWQEVDd>r}=R;qTo{=cgeRVhK5{{Rm)>n7H94-a^j?V{9gV<=RdBe;CV
z;GX>C9^mz^-^bn<)ckWSQCUE3H7h&2c_a>_Zo`F<y~pwXG-4Z!T$e@q9Pzb0LX+G4
z?2jM#$Kv}v561eJhWsme6tHQF8c0#W6TZ+K01qS+kHFPG416ZlFYFgn)<wjcMcG-=
zUNh#a5s#Z4KR$6@3~R|!jb^oyy8gWnp!RWZl6^P(zs&lx;RTzI4A^KkmJ1D)q^m4p
zS1w$hta0`0+PaU99yqh`M}|*?w6=_ETBW%&$enF%$-!brMq|SJl6zOrV<kG1)#};F
z>|;DsC_!m<-{<(AE8wd=55u~3_r*UOA%nx(0bQ_XFLN<JyMi!!lHGj<N%gOt{CDGj
z6Z~fJ&ZpxIW>%JY0eIk3`=}vbyApzU0DfmDl55b*smIz%ytazB&F}Yqr&cOn-xp=H
zbp2oH_cH=mp;?MSDFM-l3_;p)ll^ONM7J|p%@`^jRY@gB1Qy8Y&UoUz3eDQ@$l4KB
zFqQtzs@gP)fuo%ZjB&#c%N6uKuW}46cOwAsTtq+(j4Kxh2iqdKGZdu+pJsL7uL{v;
zQKC+h#;qHSGKI<Z0H12;;t{gtlre9cf%WFTGNMXWKJpjkOwqFq<!2u;11B8g^7j>@
z;g|uzEZN%JW9#|Ur(|a}7R8R?QO}l6MhMC8iqVGnFvA=i9x9fu=Pg(^wI_n{711ON
z1_<l=R7T+$!-g1Q0SBgPmi9Pj4Q`88w(-irlmn7+#&PtoWcYVy3TX2p$MZV?20w=x
ztsxc6eExY-OAOQQiF`L_JXgAblGMirNeur0FMhn&Iq?=l4Uw6MWlX5rc&nToT8rHB
zu+me;#ixC~`yM@Wa3zlcxpE70fr|N;_KWdy-fGtV7Pg%1wNW(c4?BqYLHrN?J?&n$
zQ$<w7#lD)KN10S~u+A&4hmkrth)pbcQd|R$xUFptBDV4(0MbmMRIYJ?anEtn)3tqN
zXYRY7FG}3%$6<A`6HbmYcH7_#jz|NM$G7vYLsTYPJ<g37E?v0pScM#WWc~uYYAN4S
z+mlK<9oOuicD6qfiCJ*Q9*4eJLH%+0*SY*hvU{Ht*xOt-V;ZgHsbD{a;@yG|`Qow6
zJ={}&-CvV9DJ#@RVWdK^>9JX=@TralIj)W%W4B1b136+(t}Ejstel%YEMrR0LuDN7
z0|bnIHC35Q74sJWU>tVzuE@P~JoKHl8HFpB0ONzwpb?cjuy&GgG2e>X+`ALK#003p
zZ<{3K3~^MhrD%aDgq&j;$r%20J?sfzQeOutxYy&z10OLS{D1Z9=#4flwy~-Y;l?pv
zJD%Ouj8|f6zja*Rv9}SZW?HoQBWM`G;<)Miu}JZ1K54c!kSNI<(~vX1M<5F8rk65E
z=9|*xhEf*_PXo085(Y;en6CJ(PJV~ugqMbUk1#1xNEl)>_*KYfc8R>i*u6LyKj#(q
zlaDT^=rEP^9jAtx?0|=6GlEWWUit8j843X;c*`jSbR!;>!HjQ_oiS-NeFvh(uBsIC
zj2w<DpoSL*jsW0s#%tp77E^aJoVC=rNLY5ZcpRK@UT5(RK(_L+z$c97{{XLCl>Rki
zuP<M{K33GUtwUe&qUl<FyGwC#Ce*>;<NpBF$*$L3y@SKrb-#i1sa2gDee9@n=1cwF
zIUrZ)P);-=`q(P|_PVFi_kM<swW3^TKMr+0Pf$B#nla@eZKstypTqLaeE$I9y;ko?
zzJD2NQF*r7L`5xOFSTA$Z~)I-a&zoGYuw5gB^T@Xo(69>T5jER{E2)|ccyE)?dGqf
zE^Q`>B-?_`9xzC5aqIcjd-?AyE~C5!C1VI;pl&5jQ<3=bUcEilj}A%OmG(Usz<M0o
z_k*r=2;q&5mDuve2i(|0spFmjKZQrDcxi2x;_FO=kf-;dPb<*pk8kp8c`jCA8j4NF
zvoeyxKNZCmn<R^C;w?7<)@eBN(>VxwV2pA3SE6`(#u~?mH5)rG7+=5JuIvZ;)fhlC
z!#Ab@>+k79j9O|>$jZ7?k1t(*?f(Ga9JhqN6nHzve-NbcRffF{hM#Xap6=3h2NIA^
z?%aL#EnilA3(&5v;=4^&7_}WeWb&h93WbmZf%4-c*C*1xb2OAar@JdOv|f7O*H6Io
zT<1##D9LX1eqZqa0EyguOV<1;@L$5S-`MGKi>rx<w1HQdr)=#Wz#Nn41$?ihX#OPl
zo8yrL_f2<udpNkhoc+v>HuLvY0O{Kv)$;LksZrIR_5Er1oq0NqDitxcf26hi{{SP)
ze`!yNQ23L?ar`^*Wz0vz9u$zku8qa@=K@=U*x-Vz=m!Uy^X~y)u9K`?S<4zr_N!-v
zyY$>a0|)W1q=hF>0mz=MU-kU777aB~RGQWPZ(q#C5=xhNpF84qjnJNOMloGChvbgj
zsf=P-21Wn?eb95q`$n$2cF^vom8{GSaxrV-DWH=Ctl~g()E-CEt$Rh~;V|kp*3z-^
z;etS0jAk@Ed*$+f8s)|N)Zo`+ri<mNul1@rZwB8Ri&%&of#d^`+mZTLe{8|6%%F_m
zoD+le{&n%Vl;bv!x~DYYi#E3mqhL5E0Q+~(wQAcE<7}!1PZ;Ogv5VHsDkW>8RJGdW
z%U}>lJwBgG;dPIQ&8F&-S-zWi(877RMFoE@r}C?Uomn`?)WY$4$hD{ZOYr@}ERtRA
zU~mJ*Q0I<0tLMksV@76-34&#b139Pr$h$O8)tue$WI;E@_-&)wtnm`q8(=>8?OIwV
z#eGs%mEpaeRF9N`SD#E$blth8ijG}}sGJ&4@iaVL@#9>#jtgZM*W>`KW8qbE)RXPc
zddSs2C3vq~(xKC>EM!>cU<=GiBL}uCu9Z0`sWoNzoFCcPY&;ZW8#L}3{;hA}9|_#+
znv|e<5VNo?jm_CX_dHj{nzpBNuWGaEcdzD6cI_iE91X+}2c|tetLd^RT~4d?K5saw
z%_!6J5?Kp4wc&y`6$5u50&)3s?OVEH{hrQyl2j7O94BxYIRNrcZoiK;>sNP*UC%0v
zEiDeE0GfCpofsQ(8JmuNL^${AYnQlbHDB#3NYPoMiCpdEE;-}doL7@g>vz)Mnd-YG
zp>y_ryc$o%4I)WYg_1^v&+w7|0P6t$74^r7H2LrRT{X<BnBlsDbtQSrLdZ|@{OdgF
z+Fbtt-8nGHI;nqM4Y6;r7$S0{f*XvEYiKD{$x;M($vtyl8AU5M=5}MHX0BCz?g;>A
zpve3={c60*<d!F#U<_AmHPGU0NgNbX&A<Z$4!NkN10lu+1{8EBHL_b=%KeB~mIMMe
z<n$N>RU6VGQcLIRGfitVMBgc)@Y)uiTrM%j0QIk=G+S-ZsrKU)^SRBZh*2@cK3Zv;
z%NUM5fa8oG@TM>d#fi_hD+?rece@T*Mn~4AL{aP8rF7EV!lsKtVx^aH8Sm1QU;qMf
z-|Jm$!87rCGJ^q_h9>~GVeeWnI1!P%f_o-$$6s!>`V~{}FzvOetKnj^UAt@!(Ut=^
z#yWpG_uqx@8Zbppjev8WwdLcTpwZb*?rq%nod!U=6pzO>(!>tlasg~$X1*5@q}erH
zq)#zbw>xq&F<xck>no{jo=BmQ!?94oat9qvZI)qWimsy{Q*14G(R}qCj}-A9x1fA9
zwz-2%b-M93q8TQfpZNBTyDy>ZSpNVFv{`&bu8ZsPUO11PEUq}n=bxqtue#-JrO^Z`
zI7W4)yT9Gg)cBF&X!U&>@+swbt%zlf81t}aXdLw<kJh|$KM7uHJ{i?@0<8_MjT|tk
zU@%@oo(6Du<ex!a)?UAK-%FkrWYsyVzTbPX!`f<hQNQ+nl<Z=6SR)INWX^M+T<5>7
zdIM>qKNCfz&dH0bRkC&?Atf<}ACB#&y=qF<mzm_$R&DuyN3Hw_(+d0{*R>m~VlG!y
zc%lq2NA9+e2h`*7t{20;BR7*>TWXB<vf4^e$`@%QXBi((I(9YGo#!O>JjyOkRa)Ih
z+|}Wd7mrqo(%yS=jWl<04Z+CH7mg1+Rs<K*`08PI;;96Bt+dbtn8pX0Z@@8;^e3NO
zipi(WoQ|lqDDy{qf5W5O{vLQENbshYb!82Ti6e<v$iq1!<tORJe;W0l+51`4bng^u
zcg8T<99E9Eb2<4D&~69NV<+{m&+~{>d92;^vTL&LeMDtOTsu-yTD?5m(%*^Zem(IP
zwejD^2--AGbjTUj$8b0Vf;`{IV1093-^Kp`8faewz8^Qk-vw$h%i^yPz$3i7ha2r6
zBj+mJL2T_F*)`9FUf&T6CAZdIomb{@;%PiK3K(eo{#yPl`6dV>^2uDtdHIHVd-`)w
zS<m)eL{923q<{l*4n_~_Utd)w<cz4^(Oru-Ov!vMSZ|G=b0|3hhZ+2RYgXK@<Y+)$
ztgMBPBw*zK04|lwEApr0cB@^aMdEl%>abk6;#5Q|4tXBDf1Fo$4x#p|tEP@jBf|%L
zb&qdf`)B#rJ$-3MPwM5u{O-p^;C)S8BM8}7IaVwI+uQXu=@z%;qhX$^03o~Qr|DlO
zj;Cs^A8mrE&q+3DTiqxNhQ@f$;(4uWYs6+%kl>ZbAoi|AtaVE5HjVX>XHcp-jB+vC
z{3{Pu(e0I(!4mCYO9O+No@+f0Y7dp!>T_?RX)h>dvW+A^Hto0_YTcEUlt>ol$qJH4
zBLpAvYiQJyYnb+Fs7^eqbF$F9CE&Z*qB^1#ECcS120-_&pHJ|g!p%11HPljVXv1d%
z8@iF7psz|5VHIvmpEr!2J~br_JW}jZ@!f}mAchN14%;I%j6oy}_v`Kc70<<E4ZWC=
z<3MBkgV6f^pQTPBe9+fJo}B9{Fjf9N+4D#39q|$MjZu6ZVL1Cen+Lfn*$ppc&wK;<
zn(_NhqzTATf~)fZ+#k-qt1YGVd=yt#uiyUw0Qp>W{k|#Rrh_cx5?+HMfrboA43m?`
zIO4bMrg`-nZ6a9JJeI*#$pwpK{{S#6TJlZ5Bt{-BE1k5^NfxJkLaTk2X-0j3=kVly
zmCty34>MG}FA^cVj#z^5!#g=(NbGT5Z8vDi`W^FL=H@?uOWOF)Pn}dRmvGJ*dUqiH
zmG_PPnv3}+k0ecH7bpA5z~}O=eE$IWYD@WF=5t}1RieEA0LXL4iKSK;`GCi{0<;}j
zzUy_t<C^&@dtLedX4tuV>fhFc4I3<K91uzCnvKvhlu$Cj9(z|(c6uClO<b(eF~-Jk
zloQ8Kr9~^AKsm>#?^{MsW@l^aF~X|^T=F^Nr?q72QUD7QIUM?d{(IHKeM{EIP4Ipb
zajCgDIFkn;X1<rxEkt(U<DegveD-9oi)iM|C1@mzE)H@>OmIyhi*Udld)6yfc(<|~
z6OE*t9@QX4Ly|tV(+fv)88*f=z#X9bRBdvAV|HmuvRf4jZJ&#VNe#n!Y$V`ga_v8r
zJYB@GZZ1JQo;n^yew|hqXW3AxXq|6>?ONt(WdLkb_kcZX+Wr~by5C403jDxhB>HpD
z<6b6XCX|utVUm-%@BSaT5|mIzazP@yD1wDhx%zrn#Nty@)XNa9B#ERa$Z|#j9<}Da
zJJheOtS(`-xRDZ1yaC|j{{XLAV5_=%MAHdIH798;503m+?EWQ`%BD#f$jf>HMSC2t
z7lix|rD(cxs@&^vi;J0;hAW;IKA8vfufC+eaTnwmm;1=mTVL`#tKzn|YXy~$hoKB+
zW?5!pP88?9KN^?BY&2il>dqvY{{XZ#9Zbt1Eruu*073KsfnMGgE*NO3Ezg<EXYH$}
z7k_*5O!IF8*+Z##uF4CA^DXU^&m(Th`8fl(J-^Qz@pz^wJW+U;p`*9Ix{l@-asH{$
zf}Hjk2lTIAmqq=5TAqCMoS#jPqV)|cQ}EZoy9d+2`(*zBYt|)(K3R)M7B)V^ApRB0
zLE&v5#2SsCj%{tqL$1Oknlbl8$}ryi_37TWk5~O@c@(Ph##3Efm*aH)<Z=EGztwaN
zYyJ_*G}-U8i;L!n!?YJi$txn0#sOabze@DILq*bTA==3lg88IrbvRUF7iV@~lym^T
zIP~<XsO3ryNqoOQpKnvDU&oC&?DhQg`JFC-<NGaJ!}?O)z#zPq?tL}q2ZuyfP(a7=
zZ45rO-}oO-ll~N@w`nEo#}2u2Eh90Ew58i=QR+zCKN|R~;+L~-toPNg!TzlJDl`88
zV_0OgbBEyH=#0M|_{+lIv$w;h)NRa9u3zR29?`&Oa8qmC5!nD@tL@M6aqy10u3q?)
zSG?DCR(Wo3r83DOjBN+|qmBT;81xm-!xS8$QyWuxJ1>_10FIv`G4&lvntw@u!N1DH
zHp?E|AU`o1SyTbnr#SZJtM0dxP?1&_P7d7Q<LZAAUqae)WT;6csOStcGZ|gHvH((C
z92}l8`Sh(A%u%R>$+*XfBHY;<ax%PhIqg{0T@p8@+uSv$g5e^W6}Lu6$i@K&Cyae-
zrPJ@0^unf2XSFCok-I3_$2~F$u4<{ul1A~mm&lXCx|7;U1Yxlokl>y$It+eaoqBzS
ztg=M1ETHF>On__WvnqC-&#TJkdTFzuvA#k|uijIGla8bOb6fV4DUC@^LC-B-OZQ#T
z>gv_an|aveslZ+U=rjE~Rf~obM}}ZaFHu8<?2K<_W8K@VgDknoz#w%006f)ME$)FS
zY6<zVwTBfB4`y{js)xKR8lI(V`-5oYWS^8A751$K)b;H~K#*y!szAYW)7PKQy6MiU
zR(7#d#L~Y!jhJk{!vfuE6Zx~SATI?}`U>KHD|qmDTTZmJfz_|I35C77ocyHYbCKu)
z{K&0i8CIznt$(dgpTt%6jn#T<q4CzQeKqE*dwj!tPdR^>0C_*C{{ZXK+boX)AcQPt
zP44{k1K07dytgehk@1>NtCKFxXf2&fN5q?F#(4|;BkRbmKMdQ8{{R=-LO?@ucPS$|
zC9%)q4RF@GjGvP`C`oRPzBr|p?^lsW?<QN9JHY@D%lY$~%F<bX;U~9sP|-&r+M~H;
zKbA*N!|PspZ&&5|9kNQzGY7+QJ*SFv=^P+mwyNQqC5M<tBR>6W@2OHpw6bys@9de0
z&wYa*%Qc36+oK2lZjMSm?REWhBHXfEN>p;BwtozNpQTPiZVQev#!pdSF9hvmEKB|7
zqZM|jB~L5>=bA=|oRA0r@yPG({(Dx<H11(?31f6_4o`E|s!9s5A&yVBeQS8FE@gde
zin27FoD7dorDN*TxGq?NLY#n46}n#a#-5ftPk?T>8nmiG%CR}e_}A2sMY7#VJngTZ
z%oXu+XC`GWV!Vi%3Ho;Cq>3SoHZkdn!kX0bWX8(t5Xe2nQl92VZK^tY3M$R55L1s<
zLdi4oO(?c=&QDs&Q*zatDJ7ym7Z!DQ+^7I<K2QMd+K{Y;wyc2Tk};FTe#6Vm&!UW+
zBdP2k46PCk18M^0+j9a4=bmfSd=!dhk;47fJ$UcUe4ajS%6C482^FJTp3mWIheFNr
zoMO9}*oDC(J%xOZBUu?@t;|f#m>3R79SwP>k7NSYLO>Z(bD#6+Q%2V|z^l|gMDc`3
zJVahRmS#P=bDZYAB7IIBZ$r`z%d*dB7`9EmfE*9Z=N0-k6{kiqeZR=d8+g=GT^syU
zJj(LU%U9MG3)M&<iP%b6fh^0$N%zn5te+p;-p6fWq&$rzb~f@lC_Do4XFT=53;EZ-
z8`(tpTGr>ekMP<c_j<ka1>Fs+5)ULEoj)q0Xj@UVi3PH}@Ht?N2@TI*e)Zo^N{O72
zk2TTthP~sd&xZUm<x&Y>L$qlm3zR@-ZNZfA2g*Sd-wD2-V-^0F6e$gj{{Z?`s|Vd2
zHv}Is6!ume;NzOwo!k@tzpwZQgY5Y!w7cK>`CR7p`z>PEM!2=pVKK{a`I>M(a8&%t
z4{YP{$*BAxcAEEvwXGqO$`)475O!=j2PB6-?y`Z?_=lxsiBk3wYjf1WC{DdMExDEc
zZo{nn{{RE%-WAd>ZhqNsd#Vs6l=KA)pvmikMt!qiM|?T>iQumcd=Aug-ET^`Nc0ys
z_Xq;8l#_)KlYk2n2jiOgZ0=QYm`JKi;`}a;LcI^E&ZRzWV>RgQCcnt|KjRO?{d?la
zjOOufw<p=e!)2rjM%Zn^I}i_H+;y%sgnL(H$8!9qImg#IuS*Gsjt>nCJRicX{%`Lp
zO-gP_Y5xEKxnhpi$tigPEQ-7Hj(d#yRcm*7bvML=80nsenv3fub;(^T3B0wlI>^P4
z<b&u>JbLu0?C%<7D<<Ih8wq2`{5#P$++UGVjh)w0+>-gae5j7a*brAaJvl#^KmBSn
ztEr-e9b_vcCjgRjh8X_<>(?%>EqR?bNtf&{Tx&ALZ0-_t$T=W$j=!Ei3hMkh;>eom
zZ0?<wc-v$1!*Sd3&3Sn0PHOA1>t(eR7cZIUT28YBh_4)@lffrHt#-O?!d*uYM_hsl
z8S7s?Qt8<GT5UMq#@)M&o=9WUIpF(#m2N1!z(EH9V?F3vm`YAJW!p_DZe2+@$Oi*B
zBD5^@C4zr0NR)0ovv&9Y06vsj=QT?9_fCcl0>(JMc@P-@24U3ISv1oFut<jhgWEi3
zidSvua7Pf`?#xT*!^mWF#3113r?q@>@gv3)_^aY={mf|3Wur$lHo%ew5lCkrR^%V0
zdl_9Wda{%IG5qv7@s(U)q3Ql-n*RW;oXo`hyn&1W0mpC5*1d(c*i4g^RRM@ncr44u
zKac5OUsp(<FHcz#+{PrB!x`Q!Vl5*%3Ng1JbI=1?pABu6<HlNBFv`S0B~+eOv-;#$
z1y;SBuh{fyCZ3056cQV~M{eAxnF90}Gb;Uin#Zt?-|fcbKvM}U8$Ae9&*@%Wotfxv
z+0K|uI>Z;M4sI?WxQLE3mkfIL=D$IpjyBWupvNpAT;QBzV+?+kmU-_`r~P&~9+i{z
z{EVF}3Dt>U##byolxH93-mfrH+eqZ+2EJ|z%_hvT5^kfna=9vzk{oh)867FUV-^4~
z`G!bS&U#l@D%}{xw6z&1$z7q3az_KDQ=Eht;EqW?+;Ljd)!50qYEhO!f<^{#N$vQ1
z)&{W7PT+HqoOAv~bW=&ODOmJh*~Zdajau&GX=PFX<G-zaOo~=DQV&n1eC}kD04YJ%
zzQs-Y99e|<r4&|YRBVyPbJmz;a>On<>s(4s)<+jA>PIAO+_5+wr#w>#i3Sco8g9wz
zHFvQYkS_snX^(KqIUHvm^)5{-8%7DU@mezyGYN{GK2wlQM;j@2jJEQ5#&)0At$xU?
zwLO;Ik6Z8-tX|D6ZQY{?r8e*h8Sh@h;EQsB=aIqOz;x%*zBe<EBa%L&1ukT-*!Euv
zro~dnsL2MqMSa96ARKdnUnPi5yE8meyvfKOQxnmK22MDyH~4_Kw2%-EGm+Y|q@Oyu
zt^@d*pC5R#;S<EH%)fR**#Pm+t#9g@yXbxlk5dgI+(<yOOyCy&Cm@c1aqesMj4WR*
zG;(9=$KKTQEjr@!Si6SS-ZFgK=-yJf1Tk!KeLt3KqWGaTrQeI=yVK-ZEvAFWMI97I
z+kYJG&(^+^NVuihpDjLV&C8<wS%=~HUrM;t@DZc9gdkuzea)UR>5tN|bnQ*F#<#dg
z{#b4pNw)(kNF4tFI_aeEG-THzvp$sZpN2-S@ctXEIphl31WgJ9#DQdI&mBJfd8fl|
zV^`897Xt777UDKpAe)qt(DJzKNa%i*y*(c11wLBTq`dzC$oB|!yG>%|7rBxvNaI9F
zcP<t{_$qgP9DX3v<Io$!7uv1t8e*-Er*HOoSg<Plu)vIUBOjJ)X)b6u^?#woPJY6y
zVJD~j62HXF0UyCSec-Waw2dNfG3HU3t=*IabR)KS`eMAl#eOOAWw(URm1(HmFNd{D
zD_FHio*)&PBbfH*rg6y!p7rwcqh}aBlheucU)M%`HEQ(nY1HcX^}X-?c07|*y#CO?
zH)1%{I0})+(lh`CQJ+j>pVq6+#L6Uv2~6;ygMxkYUHq;oN3t-4;?t5fwCj6`ELH*^
zVi%KWe1+g=`F?`4G^m5>GM9|25L+R5=t%yR!+(zG^qrE8x{=wa4ZW52u_-4R&j+zS
z)c}fErFhjzD8PVn3Ho#Xaay&jGmMd=9ENCf7$JjgDb9ADG5&pOK#d!;4!c9B*u?O0
z(4WJ#b8^|VbaURwv?UQ;*-i-F4jktk9uGf<>rC+#mCQE-Qn!&6nBn%Ee8cqTpYxi<
z#VN&0u7^b#$tL5_((uoXZY}X`cFmEFct4gs>)5<4;@dL_S+12?MtXuu{{Z#){VT!D
zFm9B&qp|e33{+}D&vUub_3I0S-5l|i1P#H#_VxN#NvCRd&6N`<0PQ5OJoWyy=UMJ_
z)oI;a-qY_yVM;O+jEs7JoYzkc)Hk0XRSc>(bIx;1bIZg*rlhw-_W~3|EaPd$20uE6
z{{GloGAfP40$bas_|Uhp$!SW*nfT*cmrn4_{MOI5c@fB9-*t%K{{TApgG*^mz5Ia~
z$#8tO0Oui_C;3;=<aGJHr>uWAa%OW-if_;GNRh12L?Z;_l1A*0*0eO(T0t~yFcu>z
z$U8<9fPXxHlV3rIU%O||VWrJIO!XHLrNc2`Z$n1M9AIFa<J=1Ceig-!6kE*F0p&Sj
zI3V;tPQI1HT{zO0_2hcA+*@`!iHwVJslLIwLdu&@{XC)k4`0@@BeZ9;^8`pYdBKT2
z2VM{3US0G%<7?^tXmh%~t1LPxXq>r*6a+9NA251)^Iw0*EMrg7R!#`CjhLRNE0bAg
z4f_gytm2ZrRc_DnIomx-+S$COl}liNKe{veRoQQ?<Wj2Lc<Ya-{OiI{cRA`N<k})e
z8$e<{Y~U#46xSefq;>1gYo^8xw)7H50dh|R&=K{`P`H;okT9pFbN>MAs)SYUOK)O~
zjtI#E1m~?_>hhIGP%*|j^#1?~=z`Rf+`ndhEXSu!c*(@Fah~|Epsq@y0H?QqO8IQU
zeE6D=%=7V=b&@jxW+a}~It3i(sLgRxcF~zhYoP_i*iZo#LP>B-GhliXN^e~aX+gaV
zU020gW{!;|?c8yyf=Oloab8E`uiCre--QxL&aoWxE<lPSxwH6Im~1_KWlv{CHqT!T
zfOB5bdPlkWsTG{ar0qC87k5MIf5`1r9$8XN+rDsqR>{YD{gyA8ib*A@-uyYe5IV~2
z2RjeH{{UXSx8dHh*LsYQM(paO9#2n9SIXwma+Kd==<?>QuKFKA_-aD&#4-sO7#;rr
z!n(B>D#JZSex9}Qb(>D;tVWZuI?5h4QUNE7^yAjNyW&mLrJR5^Uj$>R#(1cq4r+=k
zc5i~xdY)I{uYoo?qh9=3_^+sqAHsTQ-n;T1<+~(n{6)I~)~e6qj}LgO#ya)mcv2lF
zP4M=UG`2RA%DcwZ+Yux9<Sh9(?m*}>U!>5g*Y4qKK_uUswx6r{A2W%s?XeYI-zvIR
z>h!<ex2t`RoxBfsb*K2I8+4E%yCo5ogL9Gx1HT5e^%!SM`R$}^#~ZWT{J^$z)Bga~
zUi9^q(Zxxowkcfwusj-Nv2$^|&7E_}Y-A6>dUVP6u3|wWLo`aDt1}iE7$+e2t*ARq
zKQbp9pJV(#yR)0&--a}ub^sDxDQx6+9I87qgOTa-=j&cW<G&3<;b+t|J6j21Fv#;q
zG^Aog$5pP2^2s*49!3o~PE^~`-To}t@UM*YZD+ujwiAgPRJOGuHD8-~1Yxt=2S4}K
zb?`~z4KKl(M~d~*jMj)P<FjYj(xJg54(A7o+L!Y_nj$eVahEII%TJm;9_svRUI~j(
z@cpp4wrGL!8L_;Py+d`z2*=@EZinKp0eo6pkB8d6f^<!8^2i{DW5Y@~QVARof0cRI
zs5@P)FL&kUEHtMoQj}l49oKc#`P<^B!haL|CDajhdnwx1<Ctz0h*lnl(AOIk&zPG;
zUH4<T`X6d1X-Am!@Y7REm7SH6K)MW*Ds3Xs%!iM>a65e~m+-?#*H@AxY|9n2rGp&c
zV2t}$k55=sXSrMBf-0=IA(Wi%>e(Y01L;yv&B$`B71xpePob`+wJ?p+8E#e}z$qIT
zV0R<8U#)B`=!mn3vhn=H70({^omH*PBKiq`auo*T0hNQV%bbjUT;{hlONe!A6CBaA
zmO&U}fEAQ=CqGK!#5e5Jk=us1J(;zkd^b%_VLbAMj1n^%0(y2Qw?SR5o$y;vI5!%N
z(xT@ewlnwvUTti0PSRIBYFJkFOzU*Ng?c5tWI?FO76wK-XWR9zgHQ0(cECiJ%*+l|
zo1RBw?V9tYiKRUnIvgiTS9;j$G<!4>Mq27X6mET}I{yIr>!5*QwqY>1kg)`u4m;pi
zJf|HJUx^i`E^AwVGW@bxT_U8HGDb290A$oNcy)Cs#2S9AQ#b{kK^duwr+;}ff>r8L
zkHU_B$A1F6SK==XT-s>bjkMEBtU@=*xZ?m<$UZUn8}Sq2?4^7`;j5H@5=_vcX!!Lb
zu&<-Ys!^up2+LOQ*`Ga_=1RXTTD7jdZ{~5Opjk43kIdQKjz>(7PW1abm{eUO75(f*
z7mzS`=aKF0UqxG3oS0VR%5KX%rU-)(<!%5Do%7SsewEsMH<^=JuyR2TpD_pcxAH%c
z{A+_0nx^i0bR~Hmb;>JUUoPHbnSdd1Ig}6vJMmd|#m$V-#>#fVCJ~QqpcCJ?uPv{4
zQ@Wkpj9Bf>#m1FwDuC%UDx3_A$fN;|+%<i-;v3bluvb>*-p1N8dVJ^8^sY?Z{_d1l
zc4pw+d%oY~c=gV=c+Quo?S^JTIlw!PKRVL1@jRO{(h^j2lg53khm~%NbbZ@1QZE$+
zbRJ*~M>!oa#c4z0Yk3qEk#U}V4QSzXa88#iyDzQ%wDE$I4aXVws`E~+H!BSF>(}$5
zD_bOUN-b_?-OB6x(s<55AK_fyr7O!Ss3o^HKN{(#tjy!N_20pL6lp#dvPN7VEm^q6
zNv`VZ>@<ZG^cC>fs+X%NcWmRU9(v5KBq2!y?wk*Pw8<_A9G|UW%;K(sF-_`YYg*)5
zd`%&4o$KeHjX$)6eh0RYTA_KcLay#JU6?Es@wF5eQ`f-IgO@b+J}vS0$Il=5_IV<?
z)u)C6Sotu^w~xb~gQam=eut`RP@9QNj0xnN^ZD25_*@+fs*;QrznQbCJY2a}kw>R%
ze+%_J9w#xx9X7UD0vi|{es$-%zJYOX=83J?=Qv@5&pyA6T?|6KnF=bTT%pvlpr`g+
z3oEno$IDh39W(sv(LNUVsUp?zNmA{CantntE6>bf?ISjiV+HQGDIZw)BJAATqlP#m
zjC8Kwdt)ikW1LsPRneW8sM@88qVuL!iX|n8;9wm80H5nv8s?MX{T-&&d}PkaZk}RU
zMS~>m&J_Oub$x4W8g!(q$$BpD{JWfvtdex7{BLhBKaujk#ZQTzGWet81hBqmO(#v<
zbp0*{*>7$DBso#kfC(&lu4l#CEFTTN72UqKB!k6XD4H_1?aNx(47LvLn~n#qeuIF5
zp+*pnvXfW*+y1=|7a2-45~U57{64=u{Mq9gE%WJ`&7Jy#h#WE6LlJ_1&sy{ybX@9s
zrJeqjZqr-bu|8tA%!CY(Pi{SX*SS+!CXOmvMcl~nrm<;r;+s2{moYWyE>2i&ErJho
zk)O=gkBfXLnr^9i3<^>ax<ny3`HxKSc*RnDt$GgEcRRm@zYtgZaxaE{Bmq^USm0@2
zg(XMHlh7Q1Jq|0a@#WT+ccjmt`1)DxS~v2v?Mf)gZcaXI4x<=3>s?ok*EjT!9;6zp
zcyGG-@AwY*Mey&!x?SsA=^iSxzDtN5rc)Ra7|$H%pvd;?ReXEm=J8IxG|vx28${9K
zFvJM?F4v9Br`Lgl>`iIS8BHiX7N<R>R}p!uS$;1>Xn1n|<~vrlx}N5J66r)+*DB}$
z$P7QcKl=UaKSl7CvErW`LvuEwEpD`_;{MOP&d0fM;3~*}y^LYKK=rI^(u-1)(OLfh
zUoZ1IX-!gcvi`PbqI^a1M~A<+r1*L90&9Ei9`;}C`R;_f+QLAXNnG{YzptlW#=cJR
z--55c9r)6J3|~qvQ3#gWbiqlXZ0vAHP(kbUuR4U&rOACaUZ3zkRBeZ+Ds|La_>zA<
zzo*_?lJJiT-MEAxE`S2W5Hfflm1KB5WSUJx7r^@@#loIQ!QlRR_pT@?#+66s{zuSP
z{v;CYWi*ipBxF#a$+datG5&vAbRbU*i7GQRL~YJ^{Hv}{OS1^3nACWYL1fAMrzZnG
zpnf%>r<R#rUNvMV<u8m8`PNlF8<w7;%@L9~%PD0aE-~_j;OFzLe+0`Ax}MpUN!^lr
z^~QMoE0(&wCXv}ewNmH1_(mj47~}vj2PBio>G=xkjK*m90m05e>PMlkkgWad*!t>r
z<+3bWOhMSdgN%cm)|_gwwj7<=$ieB!?@-cOktphuG;J;nYD2N_k~qyu_wq3zSb_XJ
z)N9zvbnfm;Zt_bgUBqX&9V@!<?YY?*EAzHJv4K%JD_I_1Ki#H!7McP=szx!u;|Hy1
zO>1R+Zq~Qfkle!O43eN_Kb=fxC`n2>G<;oU&2=r068Mw*AN)G;yGwbX!nzis#J1>A
zd2D^fe0T9<_H+1^@Sa(2ue4vb>44x}+bLw*>ch9|(!Rqi&DJS<8s8V^{{RHWl%<EB
zuSeJV{+Z&_>QO^9g>939RAgt29zM0`{s6v-VH1cIjB=}}1Du=|>FfdgE7HdQ00{PQ
zmz0~i)anxm{6na$N(oDi<D86^QVu^l%e0vzisQ{H580Io#yYVdpZM36C+_{nrA0n(
zxNnD=JwwEr4WWw?&3^*90{|vVFY+hwudY0QD@fONupSz58n2)OX#G~WGiUEnit`i`
z_L7tA{{S>`siE5hSe_AyP=^IU11wKZ#<Q+;6K>@c{L$oR91?R}KGE}8nnG7sGVUzy
z?Z)Id8;%JCarjny-d$S|9I}wu104Pp)fc73D5{zwOMetxL(I%Vg#aD7Bl7<MJk{m#
zlSHcCe(**};C3~lk7Jgt1#8%_zAIaW*r~f191eh=e)XO_L1{Lp1P<yL%Bk~l$v*un
zNGn|9_6<oNa`+PFG2#1D69NQ40tX!{P)PF3N$zrfmHD+-dX7G9<#6Skn<fMW03L?3
z^_!7zZf02k+73uHwUo4Gbl1Fm<?+Yk?u+1CX0@JiHOqsw6y*AUO88sGo-XkR#2s<(
zB~q}n<rhD6d-TV8`>q|rI&k{cMW;jDRMk3a3wAd^@Vo|O^CBSgl12`HTJ7Snw=pfW
zK&Su)Wl_fm+v#4uD!ZJ{suWZqq4Z3eb+!6Q3d9%=HWBS!bK@_Ds8QN0d;^j}QhEG3
zdVV!BynW;6uvnED@<{TZ5%_Fa*(#6*z*u$3=QWG)=5Te@je{@F0*v?WXq1%bP1yQM
z4Z4v&)%bF!>@fyH7$_qH(!B~Y;0EdrGw)vmT{O>67T2_QEnCYyxoIMOtbdET*Pr}E
zou;*vF=ltk^(3D4G@G4BtC59-RYxR`Hn;E<r-AhyGga{_r<tv4k*ljO&GsmY$v!jJ
zC6PO4=C7IlIrz?hh(8p3L*f^Y%Ytk7TWDDE94Ydmf%H*drRDMVmATf@jlOq2XB|`8
zOWH2C{Qm&p9(waf0}xS_m*mO*6YF080PxGg;!g`*NucW1`k&jZq>ejxZL-5~zz&Dg
z=HyqmWhm(NJn6L<`5aG!z6pFogIo}5T6gw+lnh>bsbw1xLHpkPS9jvAbHlg3FEc<|
zZ8p^u2Mfi_ia|SliNMd+uB3To%X_;M3CeBTqJMil!hHu=@n6IlS4y)n-_Leultjd&
z5uSM?&~>k3)BYe_U24|e1=RGre-OqAwUXm*CNH}H=c8lk_|}V^NiL=}X~uB9?aHoC
ztZSYf@C~i>mL;yWx$WA~QW*!AWg7w%p3M0qkUcA%@Lr`3p9FeFrmH5IbCDGI1lr1d
z`=L4G{3~iwPVz@LB&8QOyW8cr-g<tAq+PFwY#P=TxU-#2z0^6v$U3W!MpIjNS_)~8
za@H{mmrP4%BOGqnL$A@e6&0@O$}GWDQLPr<j@SGD0Lb$n9BMWn6*OzzbHX<fFN-vl
z7kZVFL9y>5Oyq!h+?gSVdZdtPzZZTNOqw-_i(K%@mhRp%L&(qtQ#1g82>_EKj-YNI
z!(LiaR8*y-y`Rrd$41XiGgRcE)(`JpKIH!Nc`Wxh@c6WVefQqmi02!z`kFiuY)AIH
zyo7GGU>Qgl%K%RuMh$aLn~fR1@AW;2)K0Wlk(&0XAdy%B^RWasOb%$W1t*xP$YX($
zcq1pLewEW}#in5?H11i{Ea3t-h~zRUaK|NE{0$aDNeb*`K3f1rc>wYF_N<<<)NpR@
z=IdH5&XptW3T)&gs8R+8C!eKK@WfziE3^^4S;su^GIQ<HxbB=LyB*eWluvr_?&r1K
zxL-}9Bk-=K&^*~$25>n%^v!&gc%?Rx_1I?RO-YwyV(hU*pf*PHk}xZ7*4)UTxz7X~
z52rPZ^+jJ-F2vFWiad-Q44!-E{{Yqb)1V@G%Qqka&U(}*rI|BVPDb{XYR79bjQWw^
z*ZJ3Vq8OqmsUglf0a;JpR!4!DzG(8JsET|dvcEXv6@DA0NcNdI>w{R{$IMO!q!Nb#
zfgE(JQrlVTHjib0Z56~44XqrC7!mX}tSUIkN-u4WTCh@!i$}-bw7={_VXIqRc+25k
zxVO4RX=c-ue6P+)PebirALv)No*vXKv`t0>Zz^3FXN}OSfq;Y&>)yWS3yN8e7SG~a
z{l>XvR|!g-_g{~1>$%tK8iZ%WH=xhM7|sAW=m|gg=&bvB5$z_KWOBt&ZN>pR&Idor
zvXpHV@;-)x*JE$tRB5bySI~6UJ5?`YJ4YDAZgcwA)q0z??y(p`HoSsn4bweq%+00C
zR-gDmU*Es={aCLpq80}jB}OsoN9k1VtxS!bnE7yUI^b8I8#yL(-KAoT))6x0)MLIm
z$;D#d=&`dF5ai?>@t&N2D(Q}oLZeacbGna**CkO-@5qzIbDEx&a|C0{IT<Cg4;=I!
zxUQ;gUgnaYGD)3RhIB~fv65FMn2q3{On#hK7pv*l6Zpcy*1{$Z^D5&!4r`KzB})-B
z_DP*egHcTV4Dbb%mfje$fx!eqy?&L_Tib<V%z5f7;bgB>$oZP`_oSC{E0z(fF@A$R
zabGWf&|kD{9t4W#OSS#=<Azw!9{&L3e@gDaVP}oRMwA)Xm(zr#=Tl^^d{cXQuY6P2
zCGifltWXlcPH+M2KhJ8~O*YcmR@yiaY#VnX4}L53S-8<l4-KMv^q}Q=_crV_aEp+q
zZZp%M=|hE%Q*N<>2^&dMk-+O*ZdaYos70icXS#S_#5Ol_l(wB@MLfQF&#(FPuDbHZ
zElSzlV%^6X9SwKM9|2dIjYT8Jeku4dpwrsusfg{|M@$OvPXk7=_{LEf$yNX<KK!5a
z>sZ0sjYZ^rc3)H4s7tdx+xTu<>`@YaVh2%=di1|5<y;K(JPrkX7A5=Vvy1*Ff~;(@
zJ`j_@$9m*$Vzhq}>4#GoxBFB=Kt@4bz?_ct7&$1`QWXZ=XUn~x<Z*wrUCxc-?}|Fk
zn)>_cui@<#=d{7u3nWpCi81QTRYnIqk4pGD=UIJd@4kR<+)KLPV}Z}t@UPRdl^9ZS
zTco~s)cIEVX;Y^q(K2uB{V>XkE}3_-k_qF20X;EWdc~xcnp_cSQ@k?TF?l?h2xHh1
ze_zJEMJVW`v?56~+BNUIadb4BT{<m({&Z-<NgGN+v-cf&^s4u1s#q<&`m(Ii6%Pzk
zF&`<%AgRgdII5?5YnsH%mexhBGva2b>n?}k%__@IlJFQy!5Q;h=a5*F*P6ZXFILdJ
zJ>qRbUl2^qs2Jpq(<F_P9s$Q<H)kfdi*30}R&rL0RHX>@G9J$3O4qM6Ul14HnKsJj
zK5FCTVe5iA`+aMt@Ratj0i|BduczKV$lbG;<T%0Sw@m#jrVS-zOz$MxN2Pc}R@C&}
zejN`{m6$&WM^S-{0)CnL3iPRUHPJ2aCNM3;kP$op^em&5KAVRb9+fpOXB2suno3P2
z*Zj{Yvhd~q0D!(VS$s$E#E~YCu1kxHDG1zQl!GFLC+5H*xb!t|#c$y+g<d<h_@m(I
z8T37GQi4MQE@Fl7;_d_6l_wus^Q-eZjxp6rKXjM;Kj3;a(wb9mSuR)oedmn)Zt#0}
z6UX|$ha-GhG{0)HZKG>jOY_D?PosA9tX~Jm8l6r^=g1bnH(oO9`sDtVoYHu9`~Lu%
zJqi_FS;A|w{ED+gA=>iXD(-e{<2g7S<MI6}7(@+rLN*y)Tjh_QzQ3h7*~Qqpjq|3F
zp{c~J6}zmvH!C?LU=RQt<J=$0pP|KPBiy4*goxCx0l^`Z_Q!1gwTzlnul;Uo1l;VG
z^<&UH52UUBpK{YK@WsTK<es3D_+$010yyN+JZ845DB@;}s{{8~5!3RoGK7??Ri}Q3
zuUZXKgwpDL0pS=G{6A|sm2<GMAY=HteR-~dC%C+gAh1BYepw|47#^PHzHYQrt0wkG
z(NL525wg{t4wq(@su2ls#^)sS-!*y_D%;C#T;m40q}Nk>Sdr9_W8{Fu5)LwbD&38`
z5*(9|af09H(zCvXQ+AGrOJu6CZqH6Q!1k@XDTHpNPU10+-Rn0io*pJHS4`Z3@stqR
z`E!6rUwYMs@krd|w*mnKRx^5D$A?yx_BJhMW@TW0QP7SnX4XzIoM3~;S|IN3k2<7m
ztZ6_)fCvN=f(?AB`(OUcuy~frPl^5n(_<R8o;>^8Xwx5QLDhgC#0G2K%JB~kT|SRT
z^Vs53_Elp)ztj5E_(xOMQd|E3J>l6T(5P&N3>Ya=y?twP((VZCEn+CCzY-SSa4-qa
z=6_21O0l$3xAc#yq@C`W*?!H|Fy8!XNl*ul#yMmylb@0-e?0zm^t#B`7vgnX?1yO}
zeQU(dB%UfU?Gy_B&Q16K05ZhjF5Hl%Mo2%MR4kylAOny=&(v3+87p4LF0I&#WD)_8
zJKzJ(YMk*#6@#fNdCq(K*F;^=wle3mQ@Ki(-I5p{o$Dg{!a0y4p}`p-j^jN2Ij*R?
zCQFmLv42T|NUfO>3aAG;>VI0B;rD}=R``c$FOpqhCCS_VeQW0`R`xTf`=)#Fm8dy(
zU!nG<muxMpqm4%aKpvb5xr`0OboQ?SHjj#vPE6oFAb6QHO+MmglNdvudspVS#mk%T
z9(+TaY>x0nApmX|#%t;LRxUN?T3r$D;OSn6H*<EwPK!*pj=>HW2a%q&X2VEp%jF7k
zigUTE-jzqJ+3dy%B@}LIHnCb;h|)zY;AaDna(Mp$Ijl=NSDxt1*5K>}0(i;in#z;+
zZo%62IX{CwKYM%8XMH)$uk!KK^a8%n@L*frCMneJ^KedogmtfX7Y<vq;PW`z(lGud
z=^tpbnOZ%-p$8{`G5UY?>*CE4NVNX|h?h3Sg0G%cPVO_4-neKh!lHeTXC<k0mzqA{
z_;9K;>u?xy0qN~tnU!S#kPZMiuY$z<Z2Ej>@dr2y11SR?!LA!yx{puPZS@P7jFDT;
zlRD!kYOo}JBC(?<8R@_EVc_G>%^UBb^Zx+t5u{pbm)eH6r%sV*_g31K?S<6RY?9_B
zbRJrh*PoPnjQiKg_T{9vl0-%bc)>mRKhnQh%VinRO?iC0zDLSezcNpCqke0D#OVAj
zr(0fXHqvShw#v~2_YTJZfKSRjNhAu4>MwhJaVvbje20D)<yG_mcK$=PcG)*(V<}2H
zqP>NrS30$lC=C<bMmB+-2^?|tuT%J%pV_`9@a~@^LG4~2nN>QLP(KdX6|L_b5i)8m
ze9tMG@?8VO@!v%gAd2QYg&b!D=DL3s+FL`e!{coQe9boQb&^63?<v2D4mlnF07|-Y
z)l0}#DeCNXI=oPLn^~Jhyqo<l1Ls&>4!`cV`y^xX{O8mBJ9T}hq{x}Rx0hs)vB=0B
zN7Q%v@m(;}RAAbSPMg9yy~Mh<n`N!U_SgDqvNK7+WdVS3p19*Cy#qk;2BUjq-Y3))
zNePljjA%J`&e8nEImM|aaa4kFYvjInI-eM6T0}kpu-6T$eY;E!unCAC=>|Qx9^-Kz
zg?#Psm&La}FYv#K{s(xIO_t%WrfpM6aEEoR`ec#ptfLqnp60yyQk3dBN26bzpWy!h
z157PNJTg-0E8odG{{WggAKN!YowN^xUM)7rCe-{V4Xn&Y3p5It&%PSGE5UQhS5#5}
z5<mm(J-o#y^cBMk{Y`m(jP$TF=4#%5<XO~X5y5XG#K9$!Rv8C?7!39LR%8rJ@-dA<
zm*t5*rml;;ZT)U{)>e{c_O%dSvc~c(t0lR3`6@X*{{YFVI!mpc<=BaYieuOqk}yag
z%CnZVtiP>7jon)w_we4t+W381;T2__PD#h!BP4#O^RFWKj?r3p`rcGKgUJ&x&&~I-
z)AR3NKY*O2j+$LlK9d<uM+qBrJ)6O+HQtdFQp!>(6cV81w&olI+lBpW(QRUi3n6bB
zEPI&ny-t7n_2lDaYOV<NFmb&I$*=0=yLK_Ch?BH%4to1l)m3CCI4pV3IPLy5#_Y65
zMMZ5#q+wV%8QL??VOQ-p2g{rsWc$*+(a%uVv6LwQI_==&1ZK6ZT&da*LCG9ePssAI
z3eQw*Th1g4lbirEoL0rNj1t4-0~q@M06K=9v^+}jwb8d`<SKmJW2SknyEk$U7_ldV
z-ljhh<khn^ZKPmO5zcE?1&-o2iclF@NFlrN(!C0MSn}(n(?2vnZf}93;g^jd@rQ@(
z2+=jkUPck7774!d4m%!C=U+a>e4(_^E+b{y+r|&c&qgG2a5Kjrj&b%_YM)rc!mnLV
zpv&tzlvmyQeuuMu$Wf%;DDft_9A|Vku91<FGb3OR%D#ls#FDE>8-U!C=n25D12=ca
zO8pXFf;->vbYIrL=2~LGa7SK*=hMAHSxUPx2Ot76eR|iQ7i|&D)wLippj9DrgZWev
z5ZOQh1B?ORn(Kx7kjhsGq96f0FU&#D;aRfmK-+-boD2?wBlF_AIjt6F6x^(9XmHDY
z7>d>%#~(IF;a;8alfn0ze!nKAcWTI`LZKtqlV2T-lZ@vV)b?=|V@nL<ebMv~MG;1b
zy$2^X1<Zj108dU0aLw6V`1oqils{@;97(6bblW*IEP$cg+P+`W>{i}a)Gik;<0p3~
zc6)JOW06PM;M}^%`wTTZP=tGGZrRyMa)xG%myw9)u&vlu(@VDVCquoIjla_s-Bw>>
zCtMdYyD+7`ms7Z8Qn=0(4%K?z+8b!Xt`)FP2d!%e*{C8aHlo?{cY-BYb$fZDE0vL5
zlpdHM=bpS*=#Rpi)VuKgsF787M7Y`j>Gbxmq0AS$nm!vbPE^rz;xCg9lRIoB!V;s@
z*XP}wo_ECQP16rB-Z98r4!jTZ>t1dVUKJbccI2(|MR}v|KZgGRys)<0*UMeU(!D^e
zeo#@=@rwNK67MT{pI?pAW70p}FhVjiJu89n!Yf+Lr1DgOfz4w{-fG5}2Hi^^IedJy
zeILL_P4O+n^J*4t4W^QaK}&dMCV5HsBLEM2`Khf*mOVZoT2cY|N3TKkuh(+8#bNCo
zuI=gn01nTR#ZR8Jq`iLs0P5zg#Ksgh8}h_6NOqn`91IUZn$EXmm1J03g$E}GjB}j(
zX1i7H?qz4oqB<Xj`T_9|jr7eb+?Q9KS+H}32RZt6>?^DNqVJN=;ytg}{%Gv&V~8(Y
zZDW)Cy8BkrjjX$)2RqhLeG~lA#CW>NH7^m`Nd(C0f3&Dmkf7k>-v>XHTJY|zcj4yL
z(io$f)H^iR&c&6``*!b9N>7y|dFiWV<=5<dL9FRlaay&UW<RnySLJdxuU<|#&(ggc
z!MC#&TZ!3C%w@Fer452eU{&$!$K{&rrrTPam6GMKc#-ZCR*v%i0)_!3MbkOPcMST1
zJNlaRzk-)B9RcOK9&8?Xxs9EEL?jct^dF^Y(@?rNaT?KS7d|NIFnGV=McfvKcxRsF
zlT9v4nI`4;`vy5t-;ct)1K<|1_J53?4G(P5UcRFYSJF0fGjG}kJ-Q!S;YmlEOKxw3
zlT>F3e|z%(0Eaz4_WAJ*l-E8D@NStXWza1y9^oS!gkncsnH=MRn)&0wwq$6!-QU_!
zD2E$}!NwV})42k?>nLFL@A{pYP1=O5(Z9c6)YkC~FgBf`#|sse;&zk~)Z}tMpFXwD
z!U{?VmNqRWPZ`<?82ozChjyp^cW0+sE>p8b&3wv_Zun+JjbkiZzR{6ZbPFi;Ek+3Z
zkb+kk!91e!Ny+O`R$k7H-(yTV_LX!!>q?G63>KPHZRTJWmHH{i_yJy3@ovR!d{1D9
z=5448G0sRQ^Xs3&zGp3MVy}JEKBpZNu-3NLJ&VBcF}M3ODEV1HWj&Mu$LsmmaLJcc
zLjM3GX9B#uU-8|~O9byiCW6GQ$|Waw?VMn7Qu&)4u0HtP(~9JB>|4B*x)aADu^XE?
z=aI%eYWhy*EyEz5csVE7`t<#3lXf|(M_o(Sj2Hk|g~oAOmeR8j21zFX9+Zzdx;E`(
z+Phff=R6<GR>ho(%mXnIj!&&CbZ3Q#TeNLkF&jt+8OR{@u7b(cj$1u>q?6{<@oMgD
zTeAFs@;m)&M%F;5Yah<Lsq3lcRo=&+e$qb+ZGJBNBi6hyVOG2ln~N7Cl$}0hAok8N
z_}Al&+g;h*{f_Deiby4r7ghuv%5X>KE9o*x-kj-ncl*yzDWC4;7t#KI@XY#y_BOZs
zH-<HRR#gMfyhII*3?i{3AMhbw>7~cy+LdKLcz|)+x8Z^-#LXn-jjOKA_a~(&zUdOW
zqU|Wz$T|7H3a=nk1#{Hok&%!;{dLI)t&Vr^BCM<v05>1Sk<fZ|s!KYPy<CCoj1R9`
z?Tz}G=+=chslubF&IrzPz|B&#wUbi3ipmxxraMR<Uchv!t1ehJUK%P>O`k&e7vZvL
z)^Sa923P>Z<C1IAbWJ)493)^5VP6x7s_NC|W*ExqqI|m}pmYiV1E;le-Y?do(e(MQ
zC2%%_j(Qrxu9`E=!ok#<iarVWqv9DnRpPsu<!r?hGN8_VdH1ez-Vt=mZmMvK8L)ZI
ze@gqj6n%ys5bTe;_I#;Dbg|OdSp@mW!hy&8wTrIbG}5#xz=R|mpQ!%;KT5h@{ZBxf
zv~(Gz+AM455&SK*@=r|v0AJFs#lC47*nEk=_Z;)@(z|Hg&9jFSB%qI!bU7I{7#$d7
zI62M_QR`o!{{RDS9{0nxUS<JQTnzQd74#VGDW-gWJzk1C4~TFF(k4bhk1er|qQ5-u
zVwT6^g~Vlse%LZjNx?lU%E7%VFD7+lcIH;@kG#GYGB%rT03;Ms_2ZiLAXFmlB;$(w
z>l3X<>d&vnr_PB$0wz^Fk=M0wJ~mb`NJ-p4$r#Vpx#_0rq+VXqo~OwF0JO%bsq3C8
zu(E>WHLSLfNi1PT44`ev<ERUa`ec24j_O#nx0-0llIXEcIaSXG1pO=aJi0c*Q%kBo
zR=iXy$$6QQG_4~!eE#noV?Da#-#_HjCQFGUHkRt{*9<b)Cq955!}YG(X-U}5Uk%aj
ze+=}kE8%H|+gAy9;;n92ZQ!<yf^A}F1d@9;D}wmRsn4tU!s7icJeb4D8a@H@F#SRQ
z01DD`=cui<jw*51Q*VFE`d2c%KLpaWT9l(7*~(o>UJnNxcI*09HO8YnOKo<Fqkiq+
zoP5Ca=kctQ<(-bSqbQTl7`4&UQdhx^n2-U%IRt;7YVLI1Z&9$mvo?_=ziPO*yg+_m
zGb3&R#yS!?^scH+wvsTamn%%~{wC;prl)mhf8ogG03l1*)8_KY{$sb&yWfO5OX$83
zy3wvln8|mrmK<$RFrXgUKc#dv%T4olJgTzhqN2Aq{8I8<!>8%q2iM>lhllRsxVqDk
z)U2tW^==PBM(lCa(cv$Kwzhse)cz;yJ{GdEvC?E)t2?A7CNh}!Id$lEoSgpvI^%Uz
zBIPHipL_oRUx^9(DlIK0?ycVae&%@p0L1T$9|}BI;U5(Edq&f>JyXSgB-9~TuBV7E
zl##N9RXNTuI(wYgk7*`t7sHp9&$G<9xp;^K5>DJ49G?FGg?aVn>PL~QYohW!ysni>
zeA1n|{FRco;7zDZCxzygPnzF_P;vm;yyNO>jF3drTdV{|e5E8X=s+hU9qSr?>PM$P
ziQJAil1F%qOxyATdK1w8f2Ddq!;cFk_NWrztE^cA0|RL5-?{!(&6!qIu<Y#1X!F;)
zJ-*)38z@SwL2?R#j-7{3YVj|LVhu~;9+hZ^K2vTu=Q!v80A)4vc~k!YXy)=~(q>oo
z4W6ywl?iOK5MOTx9Cgii5EPM0xFc}DAoHGcUVbJ1_DJo+rl>`h!V))Qr%pQYO~DO@
z0f%0^X1RH_H0VhhnAkDof(8d_zK-Pb0OSB_mF#oXN?MmK+$aTHZO$?2{&=l>W>n)l
zuucX#)AC1~U3E0A<zs*t;YS4e=l=lJTh^`{VL`zJl4!SM#>B^|yJXn`6z6Sk*trds
z0~qXS!D@W{eH%8QknB=dmKf))UV=pcaoedC*-cpUDyy0hGQ37NIT#?<<PYts;3+;H
z{C?Lh?ZHbeT#ZiIaq{9!@5j-B{Oj7t<fDvmeOKgffSZinyD!iF3G3gpHIdW)7-`DL
zLA$w{cIO%7E`Lwby^TtxrMsN+n;hqmS0cQOW9G%xZ~2+^HT0)Vc@R4}AO>t_83&q%
zX-52W&Oy&SfBNbouJ$=Dij1Jd0VJ<+-~RxwRAtC!R#sAQ1`izPo-3jWklHgQlgb4^
zC!fb7{A;oJHKm<f#&JtB21xSf1M;l138>-aZpPGCEN4^6pIgIkZ*OD(PzEXsC{xYe
zquRbke6C3&z>J%VY_)YNM;Ro0=Dv6M`Qr&7vYN)yOtH^?{M1G+rXn!&J#3DTw5*%x
ze4Bl5GP_Jy=5lh`<C9ZpkVzzq8=xhIN`c=#-D~a?lBcQmE-5_??LzIWpkSeVz`Zu~
z{Hv5mn(pv2u|B->^sO+;(Q-#UXR0<|ZM-EjfER*)Gx^qS{r$WUI>b)-3ER%m)4BZX
z(V-h7$izvvq4L(8#cyLIZNm%`+nW6X{hx26y71kp4!MayBpin0ujk&q%zl)S^BC27
zN2d7J)#uXYIM2v(bJD**JYgC~@m}P`5-1ab3FuF+=y|Ur33leZjq*3|+tc$t+4xAz
z+C{3iI7Q$eYV|e_;52S?(AVeKj#pK=d7o*GR+gQHtXDZ=(;NYSGhAniW1K5SnI=QD
zZaEyE@+r}D<55N^#|L*O&7wY1{h%Y$ZEx+ZEausB1XnFIfDT<qDx*EHde?=@CAqn2
zWQdoSE&(~u8UFwuewF&}6{kWvbUtqorR`<R!UaOINk14+Lj!_2^dIM?Y-zfkotBXB
z+So>QN#)$KxX#7k@VNIl^uhM6qb9DBGMS;^%j=Cl#&Bvg-DdSfj3$4Wql6$Heg6P1
zDgHZ_-sWp@ZUZz?vdDAG@xdJWoZ}tnlU&G-Rc2<}PcE2{=&I`C;!z~cmfU*<&N_3S
z{{U5D+}lS9mKkN+iC-y_NE!4Q;PKnN3d%(-Rgt3R8;t_q6Xq;ZTojQ&`^mIzZ1%y&
zuUywl<69%A!=w0iG9<fQH_U{o!#5)d@0=4`u8A4Rr0?o&{1Ndku`aTaUffD8<^f$@
zi3j*W=b`7E<E?!V+Qy$}e|>vnF!D5#k9HL~G8I24ANS8cuNBiJ?(+9MoJ=3Iy4v5K
zhnjf$eRspA>&8A8v0IC#wOhY19m#V61I*8^#=*zERM0<aKM+OX7`0tb!*<uUc9&7v
z-Pw805>o0)NOPa=Fvm`n=hbtymA|cyr-zOr5uNPTntFa{$JD+e{1nutlf*Zk1i8>P
z4OmSDzt|aMF-AtyHaGz1AbuyeFb@FyIo2+;zYq9-$D-C(azkH6K*>2Jjxad~sjf*>
zQ(W~`pLMpEPegapQ^T%U`^w)x@+j+m1B=74UtSGH9}xclq`WTH2Xsip;BRn!0qN=1
zy!^C@cJ4wjjZ9&)k}==({c9Ai-JYEe_)nd4HD)`*)^Brt9J_Z$fIiRx<mVsf+P&-H
zzLIT~re_2WxEQY+JD<7AeFjepzGQdeH+ajC0px-B0gCWVWm8l5sMDmXRxQK@;1A#c
zbKjcta=5ipa(yDtLo#X7Nq0S`!d9j&JWC3ys~x$=QP5XVh<8R*XAC$4kMqTOm78^B
z{Le;>qe?5t(TJ+X+mwbQ1fF|T4!I0a^NjlgpVzH(wXTDW>_rTW2+L=_N3C6iqY?<|
z!0a<iRw|0iLiMQ(Hp<w+z{WkRR^C7WUaV9McFk&&Z1XEF#+AI=WdJc#pG=C`x0*%T
z74yy;9cWEoQ^&+dO-_?fo;2F4&I!otn%=TtKJe@~G~ssc&zr<1n{3**kg}-&@H$q6
z4hrM>9xJhEd6QZfp^yW>z{jP0GyebuJ@6pA(fl#-8r~tg(&6;$haHkZxpV&j0$hGI
z=w-9^c<N2{)9)S@{?&Z{03#pZorm^+!`}~EGN{F@G9G#P&g1%;^n@a7CXJMW7t9Ph
z`u?BFyxNkzY0CcqX`fk*e+*Y-Q+?;<EuMb%J7@m@*Hz?V3j{oqk;hu4ZO$gdI3Qt;
z-uS9FC_=bZV%<h@oM*LfP1|y1xs@P!7@S~tAo_Q&SNI2MANItvwg;Aheqb}tKi0VO
zS+z->6q5S9?b!Mz{zA6sbHN>rOQeQm+yLNazD^p{x#2ZxMo)|NbklU{rY=5JBxb%m
z@y5FP*0m{_i!SrQ>EHFPoW35@66CrcQN#3CB&N?Z)QDFsA8H2qhqieBbp1C7%Q<bQ
z1fFw|jPqYvv^740TFXMdxvGMEwR{eF&nMgIRrH8VgU*l~6(knxobg?BS1b}ZYrWYm
z)yVS%1iG|sxv+7Ojw=dyTJas2?Hh<dI^!9~<zAg6lRTP@?vI_8C%2VkFm1yF)RFjC
z+JCbSq9yR`Fhs-T!t}`NjGx2#SGA4SjnACLr0BEW{7%gJT%fleS?GPg`t|U4kF?jf
z_?<MYjq{u+#sD1fKVHAeyj(7llJaB7@9jS0>#u~8meTCo10@4sb{MZ*h>;is4C9bH
z3jF&Qe`?b1ea<@SNR&A$*crerf#2G=pA-n?x`H<hu{7(r=bu{746R-_?qh^nw!1Us
zU)n#z&o_*1tz%O2UK^Jv2i#5=AILZ5UITeP*r0)e?p^J*Pb6{xC%@g}>tC+mCG9A|
zqrk<lXClUrrfM3jCOZpvmS-T041l9N=jwk--MzKa{52oh+Wrg6!VcjPIE($9^v!lj
z^82fEjjnB3o8kE<H)iTHg-n+@#(LmltlwNh8Jc7bI2lr(Fc|;>dw=@*rzH86iB9OE
zu-$3$3#WE0t;s45?2&`-*CXlLm&CR&KBI4UZ*DxDLflS@tPjjSM+A>`&*CYho4G1p
z^F{3^N`n6YQPRBprkiS{T*w#YLcF$5uR-}&Qzfc+;qG0eWz?)6?K*6UAPwc9AG^oU
z1K*t1@Upf40IQi)ZR^|mXHoFV2Ka(yxbVyttE|T%OZ`4a^1?1Sokww=Nc!}zO16Vh
zhe`WZrE?9op}JX%!U%?VV?JKuPpcEb&r0iQ^7FU-e_Ebhdhv7iYW&OcfAGc+gS>ef
z>oRydThe27pLmGG>QwFxoR8ro1CS05ewD@eui<6RgJI$wFG04F^GnuV&f`uhpE46T
z0efc~nSa8#>(Z3{<h=g?4NlrpRHoqGj?eM`0EaxkQqXlR55_ZS9wxL9UTI4j2$_M|
zg#{NqvIsr?l{9y9$*TFxtB9g-7#wFmDuOx#&3Tn#;`w_o%=PIw)sH_$?!7Er)4Wfr
z_-gr^OucQZxn>RXEWv>Uusj^(n!?pC4EH}HvhPJW1CB-rADR5CC_>V6?r(cLBzFD>
z(%L(8cR`nYs}6+YkH)>v!<N5fgv28R3}Ze0{{YXWe8y{2o})+A<#17_%xr2`>0_r)
zak~W(n3LS&HQ~Mp^EFQpY8tz)<d#r~#ke>GejK0DmRy&!t5eA$a|v2di}OAI07tcW
ztRc5m!BkLwwYIRVU|^`o2RS*<9sd9d@ucr2&s}L16iMZUQ1Yqd5D2DD=^$dG7&*W=
z2imcEJw~q8(EviH0E2;+&*f7rip_;Qenk3GlWSmWn7?d6;2aXe03N2atr*83AZ-L-
zHb)~pYe=_io_%%P(zTUx8L~$?KHV!?3GuX}WZ(`5AB_)F$FB`+Z)vltourW27|%-S
zZ01rjNi3iP#Sr+eeD*FaGj7&htf3DX<aYX2lq|&ZbC6H9cP4ogE~^5gImzmCUQhd1
zcnJJS_!r_`1}OJj!)^B4VUB#*NN_(LxcqB+bM|$iQFN00%;>vSjr*hLkB8RdPVlCj
zCQt-6@FB?P5->lQHPXYXS=?Jj@XP_&GlP!Uu2_5Wlk;cS<|+GIFCkD9f{ZvDfCTb0
zpT?UdxCF>l0&((=)vdKST(q+xXt0|=?t6Et7itQVxbep$IQ8jULsL0DQC=HHWyy?^
zP6@{#`qxw7jdo88>LPVq#7GT;&tKNOywl%{ialH%H9As@d!FH8<NZHaSYd`u##}0n
z`L6!}Odeg9@;Sg2^0btcn~~yUXuLX5XPEqB)lH^{F;*bBD~kCWP`(~xm)(HG?)+=j
z$(J`Yyw9x2;md`)>ds$Oy;<b)6lJo+;Pt`(0PEFzo3W<YkR3#d1~Pb4iu%Yww4!y+
zT&?P6czPS1Ug71tL4w492OazRcdh%0*3AmWFcTjr{x9-tveus}=x|k))3KWr@>~PZ
zmLt9}xxl0?4Ww^!&x8XwBmzx#!K8VWHqiN<-5yokyZRR6fIWR{>p$6EXxB@_N=%GM
z5wG1G^{;Ce{1d>%rs+ufZ&tUxmrHUJgB}8tUl@E=jGrEJkW_#}3}k1nYrv$^lec1W
zFXLGHJK+Sc{gG+|E(Bwr!o7|*-56596&(e97Aoqbt=#+Eb(E}$(O9X#9W(gixNjQf
zJ7=B|hK%k9w-t>Ua@0+(##kkJ*!k<@ZTQrDU8U-lvBvElmmy$5=3SV<`r!U%zGT&+
zNOc1ND(;A(fyg-^cgH<Q{Ok3crt1$C<d2@mB&O5pp{kn3uO6P3B36dns7<IaSPt18
ze>%$q&v3$M&&(L(86@K)t$Gn!+~Ad)v9+aIn^>ZTMPJ@8+9ph6<x|3+ss2?yn*=(>
zs%DXr6(F;cFgts9?e!H+-8Lrdtcp6OrtnWah1v-tRy{`tkPqX}zgnlMY6jlTEUhC{
zRaQ{WK72PM4^C+-wwFSzp1n=GJM`1M3l5H;8=Y=)%-zuw7(T_0KPuh$Kc<E8Vq5By
z%LMTTF!Q%@#{>K;q6tmAm{nY~rSmL!{{X^QUJ>ya)GRJ!w4Us>&Ajn8!*LN}vPYhR
zL~+NjPQs=5ZShxBvDf3!d`?>TNGtY9eCWxVD41ZC9rz^El<eG>Z|m^<PFj@JdR)<3
z{-hTcR<nFpdp`~8jrMsZFJnAzPDTh^k}?ik74KdV_>(q;qUv_uD$#8(ZuBcgzqPzq
z%xx+v`Gk6W*lc>Mbj~SNt0>aEKd<WK;%K}?5>C>x{B(b*@^#*`ec~NcQt@W7EN^#z
zJeQLa4=&7b0PDths+JQZQA%crd9ulX0mv#kjt{S;d6Rce-_?(L5LDwBF2#F`&nPr|
zLc1{lW41V}x@Mg{=#A9|5%9q92R(nE=TkSy8=F&Cl0B=yI!h#CV;AnifB_x-Yt!`Q
zDt3@a100Y!#e7aOeDzuOcv$jM)Z)G`c#LTN9yW1I7JH+yLHomwqN@BK@cVt50Aku>
zkIk2iWt*;l&#iUS{nlLOzSI1UI={WfsP;#)TPTlW5!?nCJu_G1GGk}}j-Vdg*M^(1
z>&n;Eu)M@0VV<NO{VD~GbF}lC&R4d97r9<&(4UtdG06w~`ck2dToS)BfI4R<(w47s
zozk&-2Fn&w4o^H{uf>4CDIE%fp7nR?a8<s==$xwnNcp(PJ-Mx0VYQbs6OKRzo$Ri8
zn1gc8<VFyj@HilIT`rwAM(x=gWDbIq9i)$)#lp(w^_;53S8?fpKdo)rl1C#L?tYc%
zLv2qErjE?GfUwI9<Wr=zOSmPrnFB{8We7Zs5n4*=HjZoA-5(5mTGb->d2@N-_<>1b
zmSs)7LUmuzit`;a;v9)@Y<|$B$jlj4y*Bgw>hN?NX}LbFpL1C(N>x`?f4v=ck?{&P
z2=h(=>5_V%@++*<{A*=$Fw-wRNF4iClB3xiRVg&JG~?FnZX*o~fs?nE;B=>h71l&j
zD{cf4*Qu%HX<XrP<$9WS8gXRbEI=HBN#}Qb)g40O)+Q*<GJ0c-{{W46n5ws(nmybi
z(#Y%n5NR^q>rqM+v~iNe=OeZ;>0e8`Ev}ro7{KPdOk;{}Npw7n;knn0ZhX`6>%^Oj
zSw`d68@pG`n(n!63G#?6SmOh^?b5w`f{UFyuB`gJ5>#+;zWbS$QY?Y5rUgba0r`6j
zao?q3U0$79_}d^pR^Xt4o-@<0(!R2qyqoN2Ia)d$U8F0d+lbWs>;nL!oa6QFR4?4i
zDyRf*Y_o10dvx@zX{*ZT1xaaQV`yyP4$ODILFxW@u2;pH+e2tAVHpK-2^cv&e;?;v
zP+ZL7m76>!NM}a?Bf01R7!~yY0PKZu@@iKu_}qXpCOA``+3(W5j8k65Ry<5fYK*RZ
zmvtGJOm=0?S7{`5>t7lE&>C2@@m`;B#QyQw91i#+AI`pdjGwe;K1$SaDIUx4b&KgX
zpfBA;2O}H`_PbA-Fm{Y%C;AHbd}6g%>V5t>-bt5X1(|?sagGgfemQiuvADRnIEpyg
z+vo>1$rRkzsx!c}s#y7Z#g{N^R=Q@otPy9PLIVu`><j~se*V?q`s%FyFx2JP7AR+S
zVh+)?b|2@xe!qZD6qH{?eEvD9RBdf{`Lj0a^xVt#nF{>R@~V<>JwE}}A1dGh{Htq6
zu{N>Cs@{Nz+k{d702G)U{v7`RI__TVY;en2Ty~#4mp0m!`$#v1QJmo9k_J6L4wUT_
zp@L~%Kb3aj@$Z~_{{SkfFLk3do0=W0SsR(IXOd7Kc_Y-ZJ^eb?6|^c=WVnlJs}1T~
z1atuXIjq*kyX<M%+}r5$J;tMG*Gu+!BDRld+OinR#>ePRYqt1z<D0qktA7n@v7yx?
zks8Wb2G^1?gSU70hB(izKApIEyYjE=`ez+@UR>8b$5YWXABjE~mrK{;^4$>J*xm)g
z+gxL8kv=*GI3S*fIj<$ueiiH1n)LP>#3?1FoeBuAkYT2U@D*G8!zUU36VFPi#Ve_3
zzpu&Z{{RkhVCpzc(t7n@h5rD|l`OnJ@ZSE@#&&vBYtX|9X(JMBHuHr$cY%|T$MO~D
zcHTPH?lfz!4#_$-t@@udgaMQ@2PzLy&;#vWby-xE*2#ZP=c`T%Q|51bY1-fL=RJJ@
zj4gyS0vLe&9D~MJr$2|KM{#nAGQ@<0MGJxJ+>W2*)+@~Glje3HP?NHSB~I^@cFr-H
z^nVBG4=9kVM{6=+Sob~o9QUp~eAPO4JFqm|=8^5*9<jHvv5G7LSY&{spMUe|SMILu
z^xH{qr<f#Yg`DK@y?OmB;pZheH{AO;rwFK?1#_(3d`a>8T*Rc<S<Cyp=K*pDrF|LT
z?GbdnITvOOm}8y^^!+Q?&FzMvPY${z_wLUlFTH$3>pivq03)M~7!^QpSE(K9>`v-{
z5}=Mce_zVH53+l5O7<j?%(1G2k_jj2Lx)(0%oKywM}BcxwRK?9Iu+$#F|t8BSCHPg
zs7YZd0B}j?^Qh}|Uz04uD<W@Wh9jPPXQgOEAw~d^f(Jd1)~#Q3a#Tvi`*~Ra7|A?x
zI`^$hX_a=dBzn_Y=+7>^I-_FVWgrl}1`TvNRIU@tJQe`;$K_QUo(3)pmE7rc=@h?w
z_2Rc}q{<wgoqJcIO{*U{S!!rR;NTIGD&@Nja1R3lv});`toVoa+3>m3ekSQ&Ay^56
zSF|yb2Le<eAJB^MS$sbn@Iv87?xG4XIVY*)cjv8oIC`A4qWq7rz{%9ZQ+`(awEYTl
zY1ejfF^QaXU^i!<o1Xsw<ke}sL#x;@3<{Otka2;?ALkX&qZ*9qnrSxmA8+wSYZ61u
z*jyI+XP@g`FNS_LTY3In%*SbP*>B<*`hQ;abHYAWdGm^F_g@Hj`pa1nSlS;xTaFb}
zXP;{9bx#1v6_@s=scu?83Bcee`g--RhRi1{HA{7S9dU7@<9Dk)AK<ovwl?iKA1jf7
zM<9QbUDuBFw9>ShWLC!1IOGFf9x9?~`LoQfoqTPX@NdRHh<<JL!V7@JF${BFGh?bv
zt=ySiKX)621UTgKJN4qe_b0+S7*!+dt4b*<OQJUJH5ZyQVPzYPVR{pfQVnYOe?(n2
z$*!&t2f<;Uxz2I_0N1ZYMaDMna#fwIg_iYan9C>;mOQ8<10(+c*G{pI&Y1a$zyr1h
zIqms=Rl2%3rLN?f#mS8%FO8@OOq_r?>&1B<zj|(N)zWf8o~(ZG?s%@MNnGTP_c!hQ
z0cmRrnU9|-Bo_xG{NlY^;7*Sxhqbn7#}Y^t!OvWK)cbi=jFT|OLJEUPA7EM}GikYH
z;~4<g$=|e=l_a|5t>8z(&Z?jegWA06Q~l<rgOt8pQag`>?88lk4h9A=dmM9K-)5k|
z2<MMZmGQXi`$;c0euIv-mh6kxF|iJ$j)dmC>*D0HCx-5#LKUt6fD(CK#~J*yT-a+%
z5f$c)aE{Yw%)bz<qmSY4n6}IN`*ygvzz6PfK;yU=uL6nw+bz$Q#68QZjGScfa@qC4
z;=f+N-`QQB1}5Cid9v5pblW>ckjN&u-bzM5+Ps01M_;Gbn+5FcGBxb1>jC*Y_TT~E
z71o{gM=whbvvrC|BA!C=%eX!i44!fH{{TGJm69!`mA;%9GhR0KT=Tb%!`u1QJ*-W-
zkGZsPE+cTqX^|8KBX%)?!O8ys^;bQ6cK1qw*%dl5Py;y6IW;M2IXx^*V$Tr%$-G_3
za&ZK%Mi7(N(ym`=BHrHC>^y?*Ey*Ze3dpCZ=Yh8eHA+q|K(cF7*1ie+U%J!pzQN*<
zvfD_XXEVxjj;+(o9-|zQ(!GOR@XVU$geAD}{IU6Quyl{i-qET1=)S0bE^E0;GSXky
z_4(PJ9eBJobx~~Xf9v|t;B545A5^i`EiLWL3HD_3wE=O3^AjYA6@UZ*z&&`u=Du#W
zQ)aTr#1>*iWM?_fKA--&^XsW6B`*4U9^M{ty_UVm7HOee#QVr3{K^h<$3y;ksHB;t
zn8&;g<D4kLJapPR{{Z#tC2g6}yVG-T!um4b-YAt1l@1t_o^jh1?VbkFV=3mUfVs%|
zcmt>SSI=h^*DH!Xk1M09Z1f1@SdhCgRYVVxI&q)tUMcZg;uCm^>HIC>mT3|;D>;k)
zS`c~;<PYhd#=Lx|5A}>nl)f11&s#IZ`x+0IccS^7kHMb+rk7@y_wa3%$Se;+b6(AA
zp(8K1CzS(^g1NI?Pu6iVXuQ7<>?kDnE=G*%Uy$8@AI79nxRoqP>(c|CYl7<5J9^lf
z-)MAGk~;qYpTeaZN~rD*PaQMXhp45aA(cQ~%y}z<pjBs#gdxr|&pkmLR$FLNW0WI=
zQJxPtJxxyptRx5zPn4e2)tj<1n$pbEg62T#bCAOTcC9$10Z9#$_*E@kndVlFm654q
zBNkA4laPHrwb0qz#$;9K0^sviw2u=N3*958(<B>1;Eem`x9sE~g+E`VcT&|O<}oVG
znvl3$FyoE^?^mIafJhk6BQ?{yI3BF<{{Y()!fCI3E&kj{!%d;wt=4;p&&vM*p$G7<
zk928L<^TW(Jm<K_*0;lJM%|k}mnxfhWqytS0H5kuyRe1h-dFD&l12}HbNN><s_5{{
zc9E84W60wpj+N6!TArhmO6LjU4GKWc@UP3b@JAT@I_I@;*Ku81Or$fbrhY=%!TSCq
z^{=AB$xU*z%fzOY(e`)jEvMRQ(Oha8s4YA!Rx;dxJqPRg*VP{pjIr9mX{W?l=WH`$
zAP-;VUzBk*S1itS*2&o0mi6iLZDjud1E}y_y}ps8M6$LDuI49>de?~l)8862&kShu
zSlisA-8ztw?&SN|m4%@!b}kfRw`0Lmbumt(*=l?ns_S>2Bh)39NePX~&gLC?$KhI*
z(!r<4<Sb*&+xKzLLyywGS9Ie}oM}Y$T}L@NGo<jQjdL`=Yq)cU$3ug+Jvgm>dsj<A
z_B&QAsxWeS&VA4M$*kH^osrK{T@HOGdy*D5EW~7Bd;9*MTI@7?5SC4KI4UuccXAJ>
z>snb}$ik$Zu5!L8d1eL(SSe<}!OjO9*PCA0hPp_Q?*M>69Q|vil1ozr?W#Rb!ln&!
zDCJP9GT0qQ1m?YSz;Rkw-$t1pVRg^HT-QG<S4iW>&zh4*(H0j89i9{B;0zOAJbuwI
zt;(w+W!6++2RXwJ#<;arE_hj9n3&(Wq40@-w~Uq_cw`^Wy~@eiV?f<{<2mBKI~>1w
z*PA~@#yj%ABxzd(2*pn%cdsb;^zz5xo9mbWSuM&;7>+n`pVKwXfJ^I?+wP8hKC)=}
zv*QKWu<**uX2@blL}<YBH-XJ~JPNZ2Vh*LBbFfkXW1r-4=zG`e_$a?+bHK#P^L8bQ
z+E-{GU=&WrZhL@7{{US6RW*c74erIx)paKz=V%$p{{TL<()3N4J2hrOeBvvKVz`S8
zSd|ag^!$5wt<MYSvtH)v3AaejmhnbLPngUUE(qt3Pinhe8A-LFJ*AYFo+_5kV$6};
zHsFhrNd#vD>D$t%c*{*qGg_WAZX$x_FkyV00v88AjT=cKQ@-WT4QW<7*M=_FRGZ0?
z*o2N^K3Lowsbkn5{g<3m>}>9@wCl|^+s(hWPqjj-{{S?om=Y%+>>Q8xY1wmGe_zuZ
zm6oO5F)gliXrPK<HB^vIYbXb7@n9E2?g!)7wR(nwrs_Ipf-XE?;QdBZb7yr7_g2X!
z)kRfdCIRDV$vF1MYT3pX=6}~?n!9c`n$f?(oX5l;6zRS<&@QcPblLRnS4NfPya^^2
z;5Ii9pktm7emyy_9C;F11Zv9IAw~%L=jq6<Nw>_~+~~u>(x%~kZpdz>Smk9^87sAw
zcmo6f0If-+MHG_*8DS$4wRYrZJpBb_Cup|L%5iRXN38f)!-6j=FuMZf<YJtkZhn>C
zCyTr>;OJcHI+RhEkd%oVbDvxR^*+_{_}+X~PiIM8pI?LJ!_w!d?2kC{Kg6#Tc=)!5
z;SDn4*3rpHWMwMy4l|y>W4ATX{66?m7Lg*~UnrK~fw+)J2aY+es=T>Y8`wwVmh8fp
zHfM<T%~}!L{LgID;8<fwB2b|K0Z(4luWSe>ByvGq^skhZuI_ymmo1BNGAwFy&}5H%
z)QYZgB8~%e9Z2Sqld&$&?T(B#;6oFRNY7fG)VT{9k+;<2p!(Bp+6r6Uiy{|Qat=mu
z&%Hw|C6KsA$m@=sI(t;T?kLL3QIW<Fs*%{XPtuS%C0onJ4p@&$B-C^!&Q9g{WF^2x
z!Nx%+iob0sG9As&Z1?R#+~TVq=FOa-pk^85jApfLWH2CZA8^1Q*0fe{L&dKh(bDOc
zY|gug=s5Ppbe0z&ai2rYb<xo)pEHbwo`&VLp@0qa#a~iN6&W00b6tA0c`w~%9~WqL
z{w46HrJ&s)Xzy)gh=cB=57xgltm2<W)h_gzepj-dNF7MY`B;Pet6VSJiSA_cP7{x#
z{Qm&R-}_3uN(jRe0or*z>pJQJZW=iT0l?3=_4Vq1I^GwHJ(l#)=XG5vS^%gNha{1V
z{{Wt~&E0q|JK0RZ9akjo&Iupq`d6n)tERb;i;A1n`akwY(&W<hNfBmmDck~wsBiLX
z>}_J&%G$u)-AKP8=bHTQh?1T%RTk{a8_gQ9f?W~wuf-qQD$m0(&8BJhiqeJHfm<HE
zeJkSc9r&YG@xHikZsvI;atAC(9fmpJbgy%Tvd>_?wN+~N^gRhvRB7@@cez%>PmaPb
zGjJ~`Dx(KEJu9T})`fL{I^5jEBoF=XO#c9$KDG5VWp?B!zF2B@SJPYRb`KO1V`}7p
zIv)Q3hfmJ9dG8YX@tsB)fjA?Mx#{15QA##Vm`YsFQ>F06j%S!lAS!Sh3-#|^E~_(I
z+cmYaaDy#@)~Pjf8m{il^Zx)6->sua=`I+64mzBS3<~80Mkt>4Sp3#zCxe2#^Y2|0
z?Q5AmwJdlC#FtuP$7=I3?q&d!>;8U~?7j-tgqpl<EalkrIXE~!=k=<b5}RipA#>Ab
z)gB+Yj!iijoy4Fdo@>W`IoK`SPVt2fzdz+(G_I!Zc$sgziHq|qd?{lbNUYc=2ZO=?
z06f>cY23o0fc*Pc$YZ~YD|bIe#iZjG<Z42wK~O-*$EA7K#hVEAFA3__PxA(Ww*%7v
zX1Q>j(ZoV;qeng+K4yF?<IfXMtZ15Uog)0QON@@e2HbvF>s(cm$rfgg*^E&z`S$Rj
zjycB_`z09iQ$BML)2P?=xuvCnE#wl$7^EoQC>c_D=eKcDO=#lgX`lr{=0rWf2O0Fv
zdG+Hps#@qx?ySrHGq-zR5i}B<Mz*le7C;#cfr%cxlUtquX_EIzhBZ);YBAlrF&F_p
zZrp*D$2E5BVBP7r-9N~spk76N<IBgAR8es5VmopJ;GX@z#8;vGNARAVf8qJ{7*b-^
z{{ZP~=r~5e4nBb3^XpnTE>y{sxhAf8@57`^{Zi`5$DOC%#<rJ1)D4WvOl^-%!x<mm
z_o})D)~E3M$0?=B32jqPxF88n$uI}~S?82>BL~#_4ASManqSxTxTf7j%KHBRU*vS2
zCDHAyH5Au8Fw-uZdox_x!25$nSxK7RzuHc4JA!f2y>sF2rJ-qFA6-iN-DlEuJ4by+
zFuchaB^|)^95MDLwodfkoBn;jL!S}NDrt3ppZq!HpAh^x7K5v{yW!i&?sOeO>L(7M
zoFgj?5(Y|<{JpEm?QQN1lFb#nzT!fJQJ-$ybsT=R$28u@WjU@?-hj&mxKkixl@9g{
zq_NI2JwBa38nvcRc^v!n%QkoWyVMMW>0EW})u!x^M-O%HMO~duy@!ppsKjz=X4Wx<
zAxTi+{Q&p%u8TwXQ*U!Ams2+vr4wOSd?@zm`2IaB#;c8?g^PwAYuxte<@NDWQp7zM
zL)5fS25H)KDzU-jrUq3&>+RCIt6M8*(8Ulq1RRyGn6F#fNy)S6Y18D2vM)uLhSedr
z5OP!lkFTX$wvc6&a@=wN{=es~ayFZ@G`5YFqIHoJ1RSnNIs6Cpsf??)%TiATasc3e
zlTi22X+4=Vd*f0F>(rBu-t|0e+ejpC&d|B*O{=pxZF0ce+>kjL#(2#`Am6y5$OoVE
z^`_O6F<LSiqHGpW7is6UB1WvEa&68A3F;~vy1AwF(T|0SC?kwEayuStM%<md@;L5(
zlt-gEYa>?KmuO)B0Qc2wSk1K*lk)W*xUIS#MR>N3g3oC=jkqJf@~(o)Rze0q<YKp^
z?0nWOUvqxWag2g7kWFjA=0zYe>7063bRToWsI1E>L!eOIzY6^J{iD1*JRk9&SXf{Y
zL8t}3h>ii=FyHw1^R00I0LE$cUy<nL6SYZ4y8ThfSzQ?s8129VAp8FSlUk{4la-MM
z2GiT{{<YN7i#@d~r(&$u25AILgK97sBOrdiTD+PJOAZV`5_%})9OLlqS5~L9j-}9C
z)3MV0HrHRk+NiqZM&vOI$<1{?6MtweXHe3Poux62oNY2-WDIt%pTuB3yNXhKbvx@}
z;N=>!-5)vKL#S#qIiB1~^AneHNh7b&cl`OPEu+O^zGLkSNZfiH^u~X}zL`|^Ymy{J
z9PgS;ev@L_o!Bxd+qiJR;Dg`s{<Yq%&Ay9b$e?+n=248EI`P-P`N686WOLP(z0-l#
z_1Uf_F6hr5FfvF4_T$$)eidKBnpC>2@RX@k1d>NV>VHbwKJ7NhvP|{8Cr*OeC)%Y>
z&>OZmtd9^*mhsB`VMY@qALZJV70yY?xmfaDTI9)kZYKfAJAxjcPJW-QW@>tjtr3bO
zEL;~VMsh#;-_pA2tF>~SlwHbp_fba*O3@9$wyOdLIXvU>uSWQPtlZpqhR)b9ZOl*=
zVmQZI=yAGi;+^>{&(L21cxE{?3u}qa43P#4j@T8${BQ6`i$<SQvjw(B#nhA2^RJhw
zS$kc3o(>lA#6|g@WAMr(M~zvsa1SHC2Nmx6X;rpX1P(Er*UMwy@8#-#lZd;g4?|in
zEN%>Naz`heSB-pr)%D#w!_!*m76NCxQya+SfUDma?nNxNlCO(|8`9|GjNB8E@Xh_n
zDHW~Vy7}9kRB{ULIpBBc+~Tpy$!Miy^Abd#YoP!DKm)hbd)MpH+Q-jSPo1`1(bQW;
z9YaU*I0TdPHb}re)piJFyDTPFZRk)Q?UGN?y8D{Foy7Z+YmU0dg&@`%P1jmpEUrO0
zZz-7UKY<whtAF8^n{{{L&l76Ga~fG%GNTpa%zOnH^#q^JwB=4e*F&D_F}Iz+6O-^<
z63gQKFKnRsw}K#C5J=tB;GV+0@57H3_l&jg1nMci&r`Nbh?R&V%xILl{wv7(R_@%t
zah-JR-(`QfqsC&>*WrJ}f3j*fIDsT+W+e*)3C`XJUf4ac?OUH4EFjiyH2(k)X;Kut
zeK{RkGIKJ=g?^n*Hn(1c)>3zpWqeIOjeo%`cn<c@#y%K6AJs06rN!$L4dXUEtN6e%
zx%AvVT>UdvyaVGsOF+B4@Xv^BKYd{_Nl!a|auvQ))DyRia!I0`tlD4K^zIcQ%-Z??
z0AJTqKOb9b7MCMI((R#_Nw^=o@(xx8kZxSBJ3ee5PQ5c;KMaWrO9YbR%s`FiF5}B%
zE5~iUc<<|2)lD~krj!z#Rg0E-TF7?W!{#wNk%uIoU!ne$>HZS%q`6rxBs-V_Q?-2N
zWs6kTDreT^m{la3N2TccCAGSTa2<#M=cxQEZr<5#n`)^F4hI7VwS1LY?sL07nw==Y
zSsKwsfkD_kPI&dH)W(tT&Q3V@{{TMKgs0fiC$V57Ng{$+o&Y3NkOhfZahC^z59TX7
zyXsQf$hNX81yn#u7zFhv{3=-S3x^yLf_?p|DQk2lwB=;!BQt_=j02o=(~6KXoVf%O
z$0Pju(~EnPC8d#MFdIW0<YSIKKhNP(2=E+`r@j}VBfVX;xz6+vPza<2atX)K(>~Ah
z`C&mNPkdB0eNie_xa5aoAay66pXaSvNbtaIC*{T{ce*m0zPB#hl24Mu1E=9zHd~5<
z2^sDMTw3UPn1$Thv0|<PbMlPfes#NLGXi7YNEpR*Lv(!ZEnfN?))F(utXPe`Yj)Cd
zpy$1IM{6DpWvO-<7(OsaJbf$V&)c)Za<BX&zAk|P3oBVn*ucTVFF%2;=xK<Jx|f$t
zM-dzO{!IDLNSPcR>O!35l@2=lcQw@6%@K$)WP)(HTsNmf{&}wXtGy3>yC#{jX=xK6
zl&>eD_Q${DQrsZhk1TwnEWmZ|To|dnk>7xg<#tiLh{+xc;B(369CQ6^8f`XPxdNnH
zvT?y9ii$N9PhN25TB78dJXUt2C^s)`VE+K0@vb`l##@V(L|ve^;z-D@tTjhgO|u%X
zRO4dpv?--R)8$KmN#mz%;Qs)gE0)ytYx|kJlJ0PD7>sazKasCVN4exmN^<loEK*-c
zk+KcNkO1mI!3QVl&~xfB(!C?WJ{fBpWOk1SZc4KH)0~`QkrHVp(a~!6F<9EQyfPdr
zD;8n5pcx%c@njEN1I2k)jCJ7ZVGI}M<w4^g<d4p(nr*F4NH4U{K9b@|Lr%_HX+J(P
zLG<?KptrQW)aF=iq~6kHN#Nx1#(P&|l7hcuXfJ5eu|gSh60l4wU<{s5C;Th2_;abP
zr;Th}jFB)-LG=FsKb3T)qelbQC+a_it^;V66330E)*=Q!*%gKHGI)oE^&>dS{hClu
zU*WHatd*~G!=k@@m!Il<_wdmPXv<><01W4+TK63+2`yDr^109H{x#ud3iX=vKS!?L
zvWxOG;s7xxCp|`M#Xo2bYWqfmPg`VG7i}zHk(@C@gV&A+YOJQ8J~9z!7d@iiujG6;
z;yKz&iFFrZ8SdC3WA3PI_4*P1MNy5|=`-qg1TbmUijqhqo}Ret=zZ(;sOXp6cvUSc
zvwG6q?&bR`%JOWICSceD_kgz1=rTu6`K=8xERxj(&~9m1?O-||EaUaXIXf#M(_Za{
zTU*N>y>X=5M5fzU^3qtr;nj$4ho%qGy9U!=z<&t~$m-JggI$ps6lF{hji*2GBh%Wp
zZqU0qY9yr?_kZU907H)OJ-k+aGqgq^PaXQkNKkfz$YJ<3bvn+gJ-5Vf5JL^bkxdd=
z&uuE46e|iLJbiOob98^#LgtsW^-uFH{8iHJ{w3(E@ef9|OMA;AEww0{qhUeZ3HB$a
z_*H)q!>32^Uq;r7x=k71YRmVMNaWc3`>Q9n%SuhgD*pi2LzXv;V+Xo+{6EOzd@rk6
z{j%x{+i$b|ty!c<jzMAbD=!}@;Pt7s`~6DKSY1}>)_0Ls&ftc_O&K7eBzGUtYbf3`
zJ6n1)yVJaSEiH796W`iJ_DR6f?j!QU7br<kPhM5Ao|zrH@&5o3{u}6)_xBq2gr#+{
zM@6`|l>jh1jmx*yPv$X85kGZbxAplEhNjhIqqEcTv1`MA85Ssn$(c%S#?VG_l0Th#
zMu!Mk*oND?fB*yQn)obzM^a6*^h_Kh7}*^~oKclftXYufC$CT|O(It#C-_0f<HdN=
z(^h&#*cF1ZrddeGH1t#>E=j=899DfUPukG1jgYGv{n4LJYDWZ}#1Jrg9=$3Z?Wv?%
zx<!~gw>Vh%3<&3^G_K6DpbfZZ2b0#9nhR@b7Gs!5z_Ok&HiO&K`BbPvw)Q+8yl0xx
zC2N_q<Dqd%ug*X_KtKI@K-hIeI0WR5#OI1Ndz|lbUD$BJxeeHHik*f@c+>($4t*+p
z4CUr9#295b=NKGuQ^Z*ckf7jg$Gr(Q^f8mVF05W$ftU>AJaOM2(zNZFifvK>``tMI
z06bQa_q06v?Ks@fu$abjNj%`6U-O#X(`DmnQb-+hTSZyi@Ud~xv~(6s0;^=5-Twfc
zZCcJ4WD}E|=j&aR-j+Uov~@J%lPQyq*&fyAKeYFSQ^kJ>bz5}+&uGbW5pIE%g>MV0
zkdp3Yg}iIR-O=!krG@s7BE>YOHozxi0uFh{)7rK4+sBq<5-#813=cWaBzjk?S~8_k
zsUJp?Yfa9xO_}b1iVz7<p|UZ7?fHJSxh|dM+o>uToM-7?9yWZE<vpyrH%4*OL$dF~
zDc}raHLnJP6})XbkWT~*asGeCxGGj@XnQe9J2Y}$Ex$-tXF_lQ1MvQJ!_Tb4r@lcY
zww!VNU+4K(xt7P=N12anRA<F^ajHy6V5&G`!yt~MkHk{lTL{RLJ4&7zdW><O{<V8^
zi&`VWjh?30gLEinnlmJ2o9|<HA7AtN*Qum1+FGcMag6c@IUoM2<CL!}4-nc&^3NT3
znQUZuw?E8C-Q3{uUNNof6Wz{Mb|AR{cAOFYJuA_n9WHanu{MQiJ=Dl;(15HCOMbn2
j*QfY<!jW3qsWC5_4n{yfH+tsB&yp5LrI*w8l~4cKgukNi

literal 0
HcmV?d00001


From 333d7580bd7a2a9deac7e3ca8cbaa5bcaf4dce17 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 1 Jun 2011 18:10:35 -0400
Subject: [PATCH 084/137] Added VideoFunhouse example of realtime image
 processing.

---
 src/Examples/CamCanny/CamCanny.hs             | 144 ------------------
 src/Examples/CamCanny/Makefile                |   8 -
 src/Examples/PerfTest/Makefile                |   2 +-
 src/Examples/VideoFunhouse/Makefile           |   2 +
 .../{CamCanny => VideoFunhouse}/Rate.hs       |   0
 .../VideoFunhouse.hs                          | 137 +++++++++--------
 6 files changed, 76 insertions(+), 217 deletions(-)
 delete mode 100644 src/Examples/CamCanny/CamCanny.hs
 delete mode 100644 src/Examples/CamCanny/Makefile
 create mode 100644 src/Examples/VideoFunhouse/Makefile
 rename src/Examples/{CamCanny => VideoFunhouse}/Rate.hs (100%)
 rename src/Examples/{CamCanny => VideoFunhouse}/VideoFunhouse.hs (50%)

diff --git a/src/Examples/CamCanny/CamCanny.hs b/src/Examples/CamCanny/CamCanny.hs
deleted file mode 100644
index f020861..0000000
--- a/src/Examples/CamCanny/CamCanny.hs
+++ /dev/null
@@ -1,144 +0,0 @@
-import AI.CV.OpenCV.HighCV
-import AI.CV.OpenCV.ArrayOps
-import AI.CV.OpenCV.Filtering
-import Control.Applicative
-import Control.Parallel
-import Rate (trackRate)
-
--- Just real-time edges
-main2 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc = canny 70 110 3 . convertRGBToGray
-
--- Edges saved to file
-main2a = do write <- createVideoWriter "hcv-edges.mp4" mpeg4CC 15 (640,480)
-            cam <- createCameraCapture (Just 0)
-            runWindow $ proc <$> cam >>= 
-                        (>>) <$> write . convertGrayToBGR <*> return
-    where proc = canny 70 110 3 . convertRGBToGray
-
--- Thick red edges added to raw video
-main1 = createCameraCapture (Just 0) >>= runWindow . fmap (add <$> id <*> proc)
-    where proc = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
-               . canny 50 90 3 . convertRGBToGray
-
-
--- Thick red edges added to smoothed video (parallelism!).
-main3 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc x = let e = edges x; s = smooth x
-                   in e `par` s `pseq` add e s
-          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 50 90 3 . convertRGBToGray
-          smooth = smoothGaussian 21
-
--- A very low-quality unsharp mask.
-main5 = createCameraCapture (Just 0) >>= runWindow . fmap proc
-    where proc x = let g = convertRGBToGray x :: GrayImage
-                   in halvsies (convertGrayToRGB . normalize cv_MinMax 200 50 $ g)
-                               (convertGrayToRGB . contrastBoost $ g) 
-    --where proc x = halvsies (sub x . sub x . smoothGaussian 5 $ x) x
-    -- where proc x = let d = convertScale 5 0 (absDiff x (smoothGaussian 5 x))
-    --                    m = thresholdBinary 50 255 (convertRGBToGray d)
-    --               in halvsies (subMask d m x) x
-
-contrastBoost :: GrayImage -> GrayImage
-contrastBoost = normalize cv_MinMax 255 0 
-              . thresholdTruncate (200::Word8)
-              . thresholdToZero 20
-
-halvsies :: ColorImage -> ColorImage -> ColorImage
-halvsies l r = cvOr l' r'
-    where l' = resetROI . set (0,0,0) . setROI (CvRect 320 0 320 480) $ l
-          r' = resetROI . set (0,0,0) . setROI (CvRect 0 0 320 480) $ r
-
--- Thick red edges added to smoothed video with framerate display.
-main6 = do rater <- trackRate
-           cam <- createCameraCapture (Just 0)
-           runWindow $ proc <$> rater <*> cam
-    where proc msg x = let e = edges x; s = smooth x
-                       in e `par` s `pseq` showFPS msg (add e s)
-          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 70 110 3 . convertRGBToGray
-          smooth = smoothGaussian 21
-          showFPS = putText (300,450) (0,255,0) . (++" FPS")
-
--- Thick red edges added to smoothed video with framerate displayed in
--- a customized font.
-main7 = do rater <- trackRate
-           cam <- createCameraCapture (Just 0)
-           str <- prepFont ComplexSerif False 1 1 2
-           let str' = str (300,450) (0,255,0) . (++ " FPS")
-           runWindow $ proc . str' <$> rater <*> cam
-    where proc msg x = let e = edges x; s = smooth x
-                       in e `par` s `pseq` msg (add e s)
-          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 70 110 3 . convertRGBToGray
-          smooth = smoothGaussian 21
-
--- Thick red edges added to smoothed video with framerate displayed in
--- a customized font saved to a video file.
-main8 = do rater <- trackRate
-           cam <- createCameraCapture (Just 0)
-           str <- prepFont ComplexSerif False 1 1 2
-           let str' = str (300,450) (0,255,0) . (++ " FPS")
-           write <- createVideoWriter "hcv.mp4" mpeg4CC 15 (640,480)
-           runWindow $ do msg <- str' <$> rater
-                          img <- proc msg <$> cam
-                          (write *> return) img
-    where proc msg x = let e = edges x; s = smooth x
-                       in e `par` s `pseq` msg (add e s)
-          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 70 110 3 . convertRGBToGray
-          smooth = smoothGaussian 21
-
--- Thick red edges added to smoothed video with framerate displayed in
--- a customized font saved to a video file. Terse code.
-main9 = do rater <- trackRate
-           cam <- createCameraCapture (Just 0)
-           str <- prepFont ComplexSerif False 1 1 2
-           let str' = str (300,450) (0,255,0) . (++ " FPS")
-           write <- createVideoWriter "hcv.mp4" mpeg4CC 15 (640,480)
-           runWindow $ (proc . str' <$> rater) <*> cam >>= 
-                       ((>>) <$> write <*> return)
-    where proc msg x = let e = edges x; s = smooth x
-                       in e `par` s `pseq` msg (add e s)
-          edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB
-                . canny 70 110 3 . convertRGBToGray
-          smooth = smoothGaussian 21
-
--- Two-tone blueprint video.
-main10 = do rater <- trackRate
-            cam <- createCameraCapture (Just 0)
-            str <- prepFont ComplexSerif False 1 1 2
-            let str' = str (300,450) (0,255,0) . (++ " FPS")
-            runWindow $ proc . str' <$> rater <*> cam
-    where proc msg x = 
-              let g = convertRGBToGray x
-                  t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
-                  g' = let light = cvAndS (255,0,0) . convertGrayToRGB $ t
-                           dark = cvAndS (180,0,0) . convertGrayToRGB 
-                                . thresholdBinaryInv 100 255 $ t
-                       in cvOr light dark
-                  neon = smoothGaussian 3 . dilate 1 . convertGrayToRGB 
-                       . canny 70 110 3 $ g
-              in g' `par` neon `pseq` msg (add neon g')
-
--- Two-tone blueprint video save to video.
-main11 = do rater <- trackRate
-            cam <- createCameraCapture (Just 0)
-            write <- createVideoWriter "blueprint.mp4" mpeg4CC 15 (640,480)
-            str <- prepFont ComplexSerif False 1 1 2
-            let str' = str (300,450) (0,255,0) . (++ " FPS")
-            runWindow $ proc . str' <$> rater <*> cam >>=
-                        (>>) <$> write <*> return
-    where proc msg x = 
-              let g = convertRGBToGray x
-                  t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
-                  g' = let light = cvAndS (255,0,0) . convertGrayToRGB $ t
-                           dark = cvAndS (180,0,0) . convertGrayToRGB 
-                                . thresholdBinaryInv 100 255 $ t
-                       in cvOr light dark
-                  neon = smoothGaussian 3 . dilate 1 . convertGrayToRGB 
-                       . canny 70 110 3 $ g
-              in g' `par` neon `pseq` msg (add neon g')
-
-main = main10
diff --git a/src/Examples/CamCanny/Makefile b/src/Examples/CamCanny/Makefile
deleted file mode 100644
index 450e040..0000000
--- a/src/Examples/CamCanny/Makefile
+++ /dev/null
@@ -1,8 +0,0 @@
-all:	CamCanny.hs Rate.hs
-	ghc -O3 CamCanny.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields
-
-fun:	VideoFunhouse.hs Rate.hs
-	ghc -O3 VideoFunhouse.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -funbox-strict-fields -fspec-constr-count=15
-
-
-# Show stats on termination: ./CamCanny +RTS -s -A8M -N
\ No newline at end of file
diff --git a/src/Examples/PerfTest/Makefile b/src/Examples/PerfTest/Makefile
index 59ef950..500f191 100644
--- a/src/Examples/PerfTest/Makefile
+++ b/src/Examples/PerfTest/Makefile
@@ -1,4 +1,4 @@
 all:	PerfTest.hs
-	ghc -O3 PerfTest.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -fspec-constr-count=15
+	ghc -O2 PerfTest.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -fspec-constr-count=15
 
 # Suggested RTS options: ./PerfTest +RTS -s -A8M -N
\ No newline at end of file
diff --git a/src/Examples/VideoFunhouse/Makefile b/src/Examples/VideoFunhouse/Makefile
new file mode 100644
index 0000000..875dae5
--- /dev/null
+++ b/src/Examples/VideoFunhouse/Makefile
@@ -0,0 +1,2 @@
+all:	VideoFunhouse.hs Rate.hs
+	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=15 -with-rtsopts="-A8M -N"
diff --git a/src/Examples/CamCanny/Rate.hs b/src/Examples/VideoFunhouse/Rate.hs
similarity index 100%
rename from src/Examples/CamCanny/Rate.hs
rename to src/Examples/VideoFunhouse/Rate.hs
diff --git a/src/Examples/CamCanny/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
similarity index 50%
rename from src/Examples/CamCanny/VideoFunhouse.hs
rename to src/Examples/VideoFunhouse/VideoFunhouse.hs
index 4a3a7b3..f0cd8ca 100644
--- a/src/Examples/CamCanny/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances #-}
+-- |An example application demonstrating realtime image processing on
+-- the video feed from an attached webcam. The executable prints usage
+-- instructions to the console when run.
 import AI.CV.OpenCV.HighCV
 import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
@@ -7,89 +9,76 @@ import Control.Parallel
 import System.Exit (exitSuccess)
 import Rate
 
+-- Canny edges
 edges = convertGrayToRGB . canny 70 110 3 . convertRGBToGray
 {-# INLINE edges #-}
 
+-- Heavily smoothed video with red edge highlights.
 edgesOnSmoothed x = let e = edges x; s = smooth x in e `par` s `pseq` add e s
-  where edges = dilate 1 . cvAndS (0,0,255) . convertGrayToRGB 
+  where edges = cvAndS (0,0,255) . convertGrayToRGB . dilate 1
               . canny 70 110 3 . convertRGBToGray
         smooth = smoothGaussian 21
 {-# INLINE edgesOnSmoothed #-}
 
--- I find running with +RTS -N2 on a dual core CPU with
--- hyper-threading to be faster than -N. The presence of HT looks like
--- more cores, but they don't seem to be helping.
-blueprint x = toned `par` neon `pseq` add neon toned
-  where g = convertRGBToGray x
-        t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
-        light = cvAndS (255,0,0) . convertGrayToRGB $ t
-        dark = cvAndS (180,0,0) . convertGrayToRGB 
-             . cvNot $ t
-        toned = cvOr light dark
-        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
-             . canny 70 110 3 $ g
-{-# INLINE blueprint #-}
-
+-- Morphological closing
 close :: GrayImage -> GrayImage
 close = erode 4 . dilate 4
 {-# INLINE close #-}
 
+-- Posterize into two shades of blue.
+twoTone :: GrayImage -> ColorImage
+twoTone g = light t `cvOr` dark t
+    where t = close . thresholdBinaryOtsu 255 $ g
+          light = cvAndS (255,0,0) . convertGrayToRGB
+          dark = cvAndS (180,0,0) . convertGrayToRGB . cvNot
+{-# INLINE twoTone #-}
+
+-- Smoothed Canny edges.
+neonEdges :: GrayImage -> ColorImage
+neonEdges = convertGrayToRGB . smoothGaussian 3 . dilate 1 . canny 70 110 3
+{-# INLINE neonEdges #-}
+
+-- A two-tone blueprint effect.
+blueprint x = toned `par` neon `pseq` add neon toned
+  where g = convertRGBToGray x
+        toned = twoTone g
+        neon = neonEdges g
+{-# INLINE blueprint #-}
+
 -- No parallelism
-blueprintSlow x = add neon toned
+blueprintSlow x = add (neonEdges g) (twoTone g)
   where g = convertRGBToGray x
-        t = erode 4 . dilate 4 . thresholdBinaryOtsu 255 $ g
-        light = cvAndS (255,0,0) . convertGrayToRGB $ t
-        dark = cvAndS (180,0,0) . convertGrayToRGB 
-             . thresholdBinaryInv 100 255 $ t
-        toned = cvOr light dark
-        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
-             . canny 70 110 3 $ g
 {-# INLINE blueprintSlow #-}
 
--- Four blue tones.
+-- Posterize into four shades of blue.
+fourTones :: GrayImage -> ColorImage
+fourTones g = cvOr light dark
+    where t = close . thresholdBinaryOtsu 255 $ g
+          lightMean = avgMask g t
+          l1 = close $ cmpS CmpGT lightMean g
+          l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
+          light = cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
+                  cvAndS (220,0,0) l2
+          t' = cvNot t
+          darkMean = avgMask g t'
+          d2 = close $ cmpS CmpLT darkMean g
+          d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
+          dark = cvAndS (180,0,0) d1 `cvOr`
+                 cvAndS (140,0,0) (convertGrayToRGB d2)
+{-# INLINE fourTones #-}
+
+-- A four-tone blueprint effect.
 blueprint2 x = toned `par` neon `pseq` add neon toned
   where g = convertRGBToGray x
-        t = close . thresholdBinaryOtsu 255 $ g
-        light = let lightMean = avgMask g t
-                    l1 = close $ cmpS CmpGT lightMean g
-                    l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
-                in cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
-                   cvAndS (220,0,0) l2
-        -- light = cvAndS (255,0,0) . convertGrayToRGB $ t
-        -- dark = cvAndS (180,0,0) . convertGrayToRGB 
-        --      . thresholdBinaryInv 100 255 $ t
-        dark = let t' = cvNot t
-                   darkMean = avgMask g t'
-                   d2 = close $ cmpS CmpLT darkMean g
-                   d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
-               in cvAndS (180,0,0) d1 `cvOr`
-                  cvAndS (140,0,0) (convertGrayToRGB d2)
-        toned = cvOr light dark
-        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
-             . canny 70 110 3 $ g
+        toned = fourTones g
+        neon = neonEdges g
 {-# INLINE blueprint2 #-}
 
-blueprint2slow x = add neon toned
+-- No parallelism
+blueprint2slow x = add (neonEdges g) (fourTones g)
   where g = convertRGBToGray x
-        t = close . thresholdBinaryOtsu 255 $ g
-        -- light = cvAndS (255,0,0) . convertGrayToRGB $ t
-        light = let lightMean = avgMask g t
-                    l1 = close $ cmpS CmpGT lightMean g
-                    l2 = convertGrayToRGB $ cvNot l1 `cvAnd` t
-                in cvAndS (255,0,0) (convertGrayToRGB l1) `cvOr` 
-                   cvAndS (220,0,0) l2
-        dark = let t' = cvNot t
-                   darkMean = avgMask g t'
-                   d2 = close $ cmpS CmpLT darkMean g
-                   d1 = convertGrayToRGB $ cvNot d2 `cvAnd` t'
-               in cvAndS (180,0,0) d1 `cvOr`
-                  cvAndS (140,0,0) (convertGrayToRGB d2)
-        toned = cvOr light dark
-        neon = convertGrayToRGB . smoothGaussian 3 . dilate 1
-             . canny 70 110 3 $ g
 {-# INLINE blueprint2slow #-}
 
-
 -- NOTE: trackRate counts all the time in between frames. In low-light
 -- situations, a camera may run at a lower rate to effect a longer
 -- exposure time. To still report a useful performance metric, the
@@ -115,8 +104,9 @@ main = do cam <- createCameraCapture (Just 0)
               checkKey b p 102 = go (not b) p
               checkKey _ _ 27 = close >> exitSuccess
               checkKey b p _ = go b p
-              go False proc = cam >>= startFrame >>= showImg . proc >> stopFrame >> 
-                              waitKey 1 >>= maybe (go False proc) (checkKey False proc)
+              go False proc = cam >>= startFrame >>= showImg . proc >> 
+                              stopFrame >> waitKey 1 >>= 
+                              maybe (go False proc) (checkKey False proc)
               go True proc = cam >>= startFrame >>= (showFPS <*>) . pure . proc >>= 
                              showImg >> stopFrame >> waitKey 1 >>=
                              maybe (go True proc) (checkKey True proc)
@@ -125,4 +115,23 @@ main = do cam <- createCameraCapture (Just 0)
               -- go True proc = cam >>= (showFPS <*>) . pure . proc >>= showImg >>
               --                waitKey 1 >>= 
               --                maybe (go True proc) (checkKey True proc)
-          go False id
\ No newline at end of file
+          showHelp
+          go False id
+
+showHelp :: IO ()
+showHelp = do p "Press 'f' to toggle framerate display"
+              p "  The rate is computed from the per-frame processing time."
+              p "  Lighting conditions and the specific camera used will"
+              p "  determine the actual rate at which frames are acquired."
+              p ""
+              p "Number keys select a video effect:"
+              p " 1 - Raw video"
+              p " 2 - Canny edges"
+              p " 3 - Smoothed image with red edge highlights"
+              p " 4 - A two-tone blueprint effect"
+              p " 5 - Two-tone blueprint effect without par annotations"
+              p " 6 - A four-tone blueprint effect"
+              p " 7 - Four-tone blueprint effect without par annotations"
+              p ""
+              p "Press Esc to exit."
+    where p = putStrLn

From 0dc0116f50e016f130cbbde9c9cbe448a1b9d517 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 1 Jun 2011 18:56:18 -0400
Subject: [PATCH 085/137] Updated README and .cabal file.

---
 HOpenCV.cabal | 14 +++++++-------
 README        |  9 +++++++--
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index b3d6fd4..0b86b70 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,20 +1,20 @@
 name: HOpenCV
-version: 0.1.2.2.1
+version: 0.2.2.2.1
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
 stability: experimental
 category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
-Tested-With:   GHC==6.12.1, GHC==6.12.3
+Tested-With:   GHC==7.0.3
 description:
    Limited bindings to OpenCV 2.2. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6, and Windows XP.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6. Windows support is untested.
    .
-   On Windows, OpenCV is assumed to be installed in the @C:\\OpenCV2.1@ directory.
+   On Windows, OpenCV is assumed to be installed in the @C:\\OpenCV2.2@ directory.
    .
    /Usage/
    .
@@ -51,9 +51,9 @@ library
    other-modules: AI.CV.OpenCV.Core.CVOp AI.CV.OpenCV.Drawing
    hs-Source-Dirs: src
    if os(windows)
-     include-dirs: C:\\OpenCV2.1\\include
-     extra-lib-dirs:     C:\\OpenCV2.1\\bin
-     extra-libraries: cxcore210, cv210, highgui210
+     include-dirs: C:\\OpenCV2.2\\include
+     extra-lib-dirs:     C:\\OpenCV2.2\\bin
+     extra-libraries: cxcore220, cv220, highgui220
    else
      extra-libraries: opencv_core,opencv_imgproc,opencv_highgui
    build-depends: base >=4 && <5, 
diff --git a/README b/README
index eba3565..6ee8269 100644
--- a/README
+++ b/README
@@ -1,7 +1,7 @@
 HOpenCV
 -------
 
-OpenCV 2.1 bindings for Haskell.
+OpenCV 2.2 bindings for Haskell.
 
 - Image color channel count and color depth are statically checked.
 
@@ -9,7 +9,12 @@ OpenCV 2.1 bindings for Haskell.
 
 - When operations are directly composed, they will be performed
   in-place where possible as the intermediate images are not
-  observable. GHC's optimizations must be enabled (e.g. -Odph).
+  observable. GHC's optimizations must be enabled (e.g. -O2).
+
+- See `src/Examples` for example programs. In particular, the
+  `VideoFunhouse` executable demonstrates realtime image processing on
+  the video feed from a webcam. Fusion of in-place operations is
+  demonstrated along with light-weight parallelism.
 
 NOTE: Only a small part of OpenCV is currently wrapped.
 

From 9ef7f63255c918c84cfb871300a1c707ffbd9c88 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Wed, 1 Jun 2011 18:59:56 -0400
Subject: [PATCH 086/137] Dead code removal.

---
 src/AI/CV/OpenCV/FloodFill.hsc | 27 ++++++---------------------
 1 file changed, 6 insertions(+), 21 deletions(-)

diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 11f44bd..47d3215 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -17,6 +17,11 @@ data FloodRange = FloodFixed | FloodFloating
 
 #include <opencv2/imgproc/imgproc_c.h>
 
+-- FIXME: This method of pushing structs onto the stack by value is
+-- potentially risky as it assumes there are no packing issues
+-- (e.g. bytes inserted between fields or at the end of the struct to
+-- ensure a desired alignment).
+
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvFloodFill"
   c_cvFloodFill :: Ptr CvArr -> CInt -> CInt -> 
                    CDouble -> CDouble -> CDouble -> CDouble ->
@@ -49,26 +54,6 @@ floodHelper (x,y) newVal loDiff upDiff range src =
 -- pixel; a flag indicating whether pixels under consideration for
 -- painting should be compared to the seed pixel ('FloodFixed') or to
 -- their neighbors ('FloodFloating'); the source image.
-{-
-floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
-              IsCvScalar s, s ~ CvScalar c d) => 
-             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
-             HIplImage c d
-floodFill seed newVal loDiff upDiff range src = 
-    fst . withDuplicateImage src $ \ptr ->
-        floodHelper seed (toCvScalar newVal) (toCvScalar loDiff) 
-                    (toCvScalar upDiff) range ptr
-
-unsafeFlood :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
-                IsCvScalar s, s ~ CvScalar c d) => 
-               (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
-               IO (HIplImage c d)
-unsafeFlood seed newVal loDiff upDiff range src = 
-    withHIplImage src $ \ptr ->
-        do floodHelper seed (toCvScalar newVal) (toCvScalar loDiff) 
-                       (toCvScalar upDiff) range ptr
-           return src
--}
 floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
               IsCvScalar s, s ~ CvScalar c d) => 
              (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
@@ -77,4 +62,4 @@ floodFill seed newVal loDiff upDiff range =
     cv $ floodHelper seed (toCvScalar newVal) (toCvScalar loDiff)
                      (toCvScalar upDiff) range
 
-{-# INLINE [1] floodFill #-}
+{-# INLINE floodFill #-}

From d3b4895ed9350aac3ac19399092540dd77f56fb9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 2 Jun 2011 01:49:48 -0400
Subject: [PATCH 087/137] Set a more reasonable version number after the big
 upgrade.

---
 HOpenCV.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 0b86b70..8f01ddd 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,5 +1,5 @@
 name: HOpenCV
-version: 0.2.2.2.1
+version: 0.2
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>

From 16ad93849b2e73bcf9b27f7bf286ac09d513b92d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 2 Jun 2011 02:25:59 -0400
Subject: [PATCH 088/137] Added VideoFunhouse support for reading a video file.

---
 src/Examples/VideoFunhouse/VideoFunhouse.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index f0cd8ca..8538094 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -1,11 +1,13 @@
 -- |An example application demonstrating realtime image processing on
--- the video feed from an attached webcam. The executable prints usage
--- instructions to the console when run.
+-- the video feed from an attached webcam or a video file specified as
+-- a command line argument. The executable prints usage instructions
+-- to the console when run.
 import AI.CV.OpenCV.HighCV
 import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
 import Control.Applicative
 import Control.Parallel
+import System.Environment (getArgs)
 import System.Exit (exitSuccess)
 import Rate
 
@@ -85,7 +87,10 @@ blueprint2slow x = add (neonEdges g) (fourTones g)
 -- perfMon monitor counts only the time a frame is being processed and
 -- drawn.
 
-main = do cam <- createCameraCapture (Just 0)
+main = do args <- getArgs
+          cam <- case args of
+                   [fname] -> createFileCaptureLoop fname
+                   _ -> createCameraCapture (Just 0)
           (showImg,close) <- namedWindow "Video Funhouse" [AutoSize]
           --rater <- trackRate
           (startFrame', curr, stopFrame) <- perfMon

From 0092e9ea660384dcd595d77735f45f10f3a3ab42 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 2 Jun 2011 02:45:26 -0400
Subject: [PATCH 089/137] Added usage instructions given --help argument.

---
 src/Examples/VideoFunhouse/VideoFunhouse.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index 8538094..e76667c 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -89,6 +89,10 @@ blueprint2slow x = add (neonEdges g) (fourTones g)
 
 main = do args <- getArgs
           cam <- case args of
+                   ["--help"] -> do putStrLn "Usage: ./VideoFunhouse [filename]"
+                                    putStr "If no file is given, a connected "
+                                    putStrLn "camera is opened."
+                                    exitSuccess
                    [fname] -> createFileCaptureLoop fname
                    _ -> createCameraCapture (Just 0)
           (showImg,close) <- namedWindow "Video Funhouse" [AutoSize]

From a5007674db35beb29ec01b0517e0a1d1f16e795c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 2 Jun 2011 03:40:07 -0400
Subject: [PATCH 090/137] Dead code removal and minor reformatting.

---
 src/AI/CV/OpenCV/Core/CVOp.hs | 18 ++++--------------
 1 file changed, 4 insertions(+), 14 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index 73c7969..f334b20 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -43,10 +43,6 @@ dupArg f = \x -> f x x
 
 -- |Operations that want an argument /and/ a compatible destination
 -- buffer, but don't need a clone of an input.
--- cv2 :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
---        (Ptr IplImage -> Ptr IplImage -> IO a) -> 
---        HIplImage c1 d1 -> HIplImage c2 d2
--- cv2 = runBinOp . BinOp . ((void .) .)
 cv2 :: forall a c1 d1 c2 d2 e.
        (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
         IplArrayType e) => 
@@ -73,20 +69,14 @@ newtype BinOp a b c =
 cbop :: BinOp b b c -> BinOp a b c -> BinOp a b c
 cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
--- withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
---            (Ptr IplImage -> Ptr IplImage -> IO a) ->
---            HIplImage c1 d1 -> IO (HIplImage c2 d2)
--- withDst f img = mkHIplImage (width img) (height img) >>= \img2 ->
---                 withHIplImage img2 (\x -> withHIplImage img (flip f x) >>
---                                           return img2)
 withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
             IplArrayType e) => 
            (Ptr e -> Ptr e -> IO a) ->
            HIplImage c1 d1 -> IO (HIplImage c2 d2)
-withDst f img = mkHIplImage (width img) (height img) >>= \img2 ->
-                withHIplImage img2 (\x -> withHIplImage img (flip f (castPtr x) . castPtr) >>
-                                          return img2)
-
+withDst f img = do img2 <- mkHIplImage (width img) (height img)
+                   _ <- withHIplImage img2 go
+                   return img2
+    where go x = withHIplImage img (flip f (castPtr x) . castPtr)
 
 runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
              IplArrayType e) => 

From d572ccc372959fd675ff21ea9e776b7f21f4cac2 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 2 Jun 2011 16:56:27 -0400
Subject: [PATCH 091/137] Code cleanup. Thanks hlint!

---
 src/AI/CV/OpenCV/ArrayOps.hs        | 20 ++++------
 src/AI/CV/OpenCV/ColorConversion.hs |  1 -
 src/AI/CV/OpenCV/Core/HIplImage.hsc | 31 ++++++++-------
 src/AI/CV/OpenCV/Core/HIplUtil.hs   | 41 ++++++++------------
 src/AI/CV/OpenCV/Core/PipelineTH.hs | 60 -----------------------------
 src/AI/CV/OpenCV/Drawing.hs         |  5 +--
 src/AI/CV/OpenCV/HighCV.hs          |  6 ++-
 src/AI/CV/OpenCV/Motion.hsc         |  5 ++-
 src/AI/CV/OpenCV/PixelUtils.hs      | 12 +++---
 src/AI/CV/OpenCV/Threshold.hs       | 19 +++------
 src/AI/CV/OpenCV/Video.hs           |  5 ++-
 src/Examples/VideoFunhouse/Rate.hs  | 44 ++++++++++-----------
 12 files changed, 87 insertions(+), 162 deletions(-)
 delete mode 100644 src/AI/CV/OpenCV/Core/PipelineTH.hs

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index ba61b1e..12971cf 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -61,10 +61,6 @@ convertScale scale shift  = cv2 $ \src dst ->
 foreign import ccall "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
-cvAndHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> 
-               IO ()
-cvAndHelper src1 src2 dst mask = c_cvAnd src1 src2 dst mask
-
 -- |Calculate the per-element bitwise conjunction of two
 -- arrays. Parameters are a mask and two source images. The mask
 -- specifies the elements of the result that will be computed via the
@@ -76,14 +72,14 @@ andMask :: (HasChannels c, HasDepth d) =>
 andMask mask src1 = cv2 $ \src2 dst -> 
                     withHIplImage src1 $ \src1' -> 
                         withHIplImage mask $ \mask' ->
-                            cvAndHelper (castPtr src1') src2 dst (castPtr mask')
+                            c_cvAnd (castPtr src1') src2 dst (castPtr mask')
 {-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
 cvAnd :: (HasChannels c, HasDepth d) => 
           HIplImage c d -> HIplImage c d ->  HIplImage c d
 cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
-             cvAndHelper (castPtr src1') src2 dst nullPtr
+             c_cvAnd (castPtr src1') src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAndS"
@@ -238,12 +234,12 @@ foreign import ccall "opencv2/core/core_c.h cvCmpS"
 data ComparisonOp = CmpEq | CmpGT | CmpGE | CmpLT | CmpLE | CmpNE
 
 cmpToCmp :: ComparisonOp -> CInt
-cmpToCmp CmpEq = unCmpOp $ cmpEq
-cmpToCmp CmpGT = unCmpOp $ cmpGT
-cmpToCmp CmpGE = unCmpOp $ cmpGE
-cmpToCmp CmpLT = unCmpOp $ cmpLT
-cmpToCmp CmpLE = unCmpOp $ cmpLE
-cmpToCmp CmpNE = unCmpOp $ cmpNE
+cmpToCmp CmpEq = unCmpOp cmpEq
+cmpToCmp CmpGT = unCmpOp cmpGT
+cmpToCmp CmpGE = unCmpOp cmpGE
+cmpToCmp CmpLT = unCmpOp cmpLT
+cmpToCmp CmpLE = unCmpOp cmpLE
+cmpToCmp CmpNE = unCmpOp cmpNE
 
 -- |Per-element comparison of an array and a scalar.
 cmpS :: HasDepth d => 
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 0ec9d1d..75a6fb1 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 -- |Type-safe color conversion functions. 
 module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index cb1ea8a..7885888 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -54,7 +54,7 @@ data TriChromatic
 data MonoChromatic
 
 class HasChannels a where
-    numChannels :: a -> Int
+    numChannels :: a -> CInt
 
 class (Storable a, Num a) => HasDepth a where
     depth      :: a -> Depth
@@ -144,24 +144,27 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
 -- pixel depth (e.g. 'Word8', 'Float').
 data HIplImage c d = (HasChannels c, HasDepth d) => 
-                     HIplImage { origin          :: {-# UNPACK #-} !Int
-                               , width           :: {-# UNPACK #-} !Int
-                               , height          :: {-# UNPACK #-} !Int
-                               , imageSize       :: {-# UNPACK #-} !Int
+                     HIplImage { origin          :: {-# UNPACK #-} !CInt
+                               , width           :: {-# UNPACK #-} !CInt
+                               , height          :: {-# UNPACK #-} !CInt
+                               , imageSize       :: {-# UNPACK #-} !CInt
                                , imageData       :: {-# UNPACK #-} !(ForeignPtr d)
                                , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
-                               , widthStep       :: {-# UNPACK #-} !Int }
+                               , widthStep       :: {-# UNPACK #-} !CInt }
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
-mkHIplImage :: forall c d. (HasChannels c, HasDepth d) => 
-               Int -> Int -> IO (HIplImage c d)
-mkHIplImage w h = 
-    do ptr <- mallocForeignPtrArray numBytes
+mkHIplImage :: forall a c d. (HasChannels c, HasDepth d, Integral a) => 
+               a -> a -> IO (HIplImage c d)
+mkHIplImage w' h' = 
+    do ptr <- mallocForeignPtrArray (fromIntegral numBytes)
        return $ HIplImage 0 w h numBytes ptr ptr stride
-    where numBytes = stride * h
-          bpp = bytesPerPixel (undefined::d)
-          stride = w * (numChannels (undefined::c) :: Int) * bpp
+    where w = fromIntegral w'
+          h = fromIntegral h'
+          numBytes = stride * h
+          bpp = fi $ bytesPerPixel (undefined::d)
+          stride = w * numChannels (undefined::c) * bpp
+          fi = fromIntegral
 
 foreign import ccall "memset"
   memset :: Ptr Word8 -> Word8 -> CInt -> IO ()
@@ -229,7 +232,7 @@ instance forall c d. (HasChannels c, HasDepth d) =>
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
     peek ptr = do
-      numChannels' <- (#peek IplImage, nChannels) ptr :: IO Int
+      numChannels' <- (#peek IplImage, nChannels) ptr :: IO CInt
       depth' <- Depth <$> (#peek IplImage, depth) ptr
       width' <- (#peek IplImage, width) ptr
       height' <- (#peek IplImage, height) ptr
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index a048edc..b100b41 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -19,7 +19,7 @@ import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
 import Control.Applicative
 import Control.Arrow (second, (***))
-import Control.Monad ((<=<), when, join)
+import Control.Monad ((<=<), when, unless, join)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -47,7 +47,7 @@ isMono = id
 -- |Return the number of color channels a 'HIplImage' has as a runtime
 -- value.
 imgChannels :: forall c d. HasChannels c => HIplImage c d -> Int
-imgChannels _ = numChannels (undefined::c)
+imgChannels _ = fromIntegral $ numChannels (undefined::c)
 
 -- |Return the number of bytes per pixel color component of an
 -- 'HIplImage'.
@@ -59,7 +59,7 @@ colorDepth _ = bytesPerPixel (undefined::d)
 -- data.
 withImagePixels :: HasDepth d => HIplImage c d -> (V.Vector d -> r) -> r
 withImagePixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
-    where n = imageSize img `div` colorDepth img
+    where n = fromIntegral (imageSize img) `div` colorDepth img
 
 -- |Return a 'V.Vector' containing a copy of the pixels that make up a
 -- 'HIplImage'.
@@ -70,7 +70,7 @@ pixels img = unsafePerformIO $
                     withForeignPtr (imageData img) $ \src -> 
                         copyBytes dst src len
                 return $ V.unsafeFromForeignPtr ptr 0 len
-    where len = imageSize img
+    where len = fromIntegral $ imageSize img
 {-# NOINLINE pixels #-}
 
 -- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
@@ -80,7 +80,7 @@ fromPtr = peek . castPtr
 -- Ensure that a file exists.
 checkFile :: FilePath -> IO ()
 checkFile f = do e <- doesFileExist f
-                 if e then return () else error $ "Can't find "++f
+                 unless e (error $ "Can't find "++f)
 
 -- |Load a color 'HIplImage' from an 8-bit image file. If the image
 -- file is grayscale, it will be converted to color.
@@ -138,7 +138,7 @@ fromPGM16 fileName =
      maxCol <- hGetLine h
      when (maxCol /= "65535") (hClose h >>
                                error (fileName ++" is not 16-bit"))
-     let numBytes = width*height*2
+     let numBytes = fromIntegral $ width*height*2
      fp <- mallocForeignPtrArray numBytes
      hSetBinaryMode h True
      withForeignPtr fp $ \ptr' ->
@@ -155,7 +155,7 @@ fromPGM16 fileName =
                                  swapBytes (offset+2)
           swapBytes 0
      hClose h
-     return $ HIplImage 0 width height numBytes fp fp (2*width)
+     return $ HIplImage 0 width height (fromIntegral numBytes) fp fp (2*width)
 
 -- |Save a 'HIplImage' to the specified file.
 toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
@@ -165,23 +165,19 @@ toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
 compatibleImage :: HIplImage c d -> IO (HIplImage c d)
-compatibleImage img@(HIplImage _ _ _ _ _ _ _) = 
-    do ptr <- mallocForeignPtrArray sz
+compatibleImage (HIplImage _ w h sz _ _ stride) = 
+    do ptr <- mallocForeignPtrArray (fromIntegral sz)
        return $ HIplImage 0 w h sz ptr ptr stride
-    where w = width img
-          h = height img
-          sz = imageSize img
-          stride = widthStep img
 
 -- |Allocate a new 'IplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing 'HIplImage'. The
 -- pixel data of the original 'HIplImage' is not copied.
 compatibleImagePtr :: forall c d. (HasChannels c, HasDepth d) =>
                       HIplImage c d -> IO (ForeignPtr IplImage)
-compatibleImagePtr img = createImageF (CvSize w' h') c d
+compatibleImagePtr img = createImageF (CvSize w' h') nc d
     where w' = fromIntegral . width $ img
           h' = fromIntegral . height $ img
-          c = fromIntegral . numChannels $ (undefined::c)
+          nc = fromIntegral . numChannels $ (undefined::c)
           d = depth (undefined::d)
 
 compatibleImagePtrPtr :: Ptr IplImage -> IO (Ptr IplImage)
@@ -191,15 +187,12 @@ compatibleImagePtrPtr =
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
 duplicateImage :: HIplImage c d -> IO (HIplImage c d)
-duplicateImage img@(HIplImage _ _ _ _ _ _ _ ) =
-    do fptr <- mallocForeignPtrArray sz
-       withForeignPtr (imageData img) $ 
-           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz
+duplicateImage (HIplImage _ w h sz pixels _ stride) =
+    do fptr <- mallocForeignPtrArray sz'
+       withForeignPtr pixels $ 
+           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz'
        return $ HIplImage 0 w h sz fptr fptr stride
-    where w = width img
-          h = height img
-          sz = imageSize img
-          stride = widthStep img
+  where sz' = fromIntegral sz
 
 -- |Clone an 'HIplImage', returning the 'Ptr' 'IplImage' underlying
 -- the clone.
@@ -292,7 +285,7 @@ unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
 getROI :: (HasChannels c, HasDepth d) =>
           (Int,Int) -> (Int,Int) -> HIplImage c d -> IO (HIplImage c d)
 getROI (rx,ry) (rw,rh) src = 
-    do img <- mkHIplImage rw rh
+    do img <- mkHIplImage (fromIntegral rw) (fromIntegral rh)
        withForeignPtr (imageData img) $ \dst ->
          withForeignPtr (imageData src) $ \src ->
            mapM_ (\(dOff, sOff) -> copyBytes (plusPtr dst dOff) 
diff --git a/src/AI/CV/OpenCV/Core/PipelineTH.hs b/src/AI/CV/OpenCV/Core/PipelineTH.hs
deleted file mode 100644
index 580b4d6..0000000
--- a/src/AI/CV/OpenCV/Core/PipelineTH.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-module AI.CV.OpenCV.Core.PipelineTH (mkPiped, mkAux) where
-import Control.Monad (when)
-import Data.List (foldl')
-import Language.Haskell.TH
-
-countArrows :: Type -> Int
-countArrows (ForallT _ _ t) = countArrows t
-countArrows ArrowT = 1
-countArrows (AppT t1 t2) = countArrows t1 + countArrows t2
-countArrows _ = 0
-
-getArity :: Exp -> Q Int
-getArity (VarE n) = do VarI _ t _ _ <- reify n
-                       return $ countArrows t
-getArity _ = error "getArity called with non VarE expression"
-
--- Declare an alias of a variable @foo@ named @fooAux@ that is
--- semantically equivalent to the original.
-mkAux :: Q Exp -> Q [Dec]
-mkAux q = do VarE n <- q
-             VarI _ t _ _ <- reify n
-             let n' = mkName $ nameBase n ++ "Aux"
-                 spec = InlineSpec True False (Just (True,1))
-             return [ SigD n' t
-                    , FunD n' [Clause [] (NormalB (VarE n)) []] 
-                    , PragmaD $ InlineP n' spec ]
-
--- Takes variables bound to safe and the unsafe functions. Generates
--- an auxiliary function semantically equivalent to the safe function
--- with the name "fooAux" (for a function named "foo"), and a
--- pipelined function of the form @fooPiped x y = pipeline (unsafe x y)
--- (fooAux x y)@. The safe function's type must be no less general
--- than the unsafe function's.
-mkPiped :: Q Exp -> Q [Dec]
-mkPiped pair = do TupE [f1,f2] <- pair
-                  arity <- getArity f1
-                  arity' <- getArity f2
-                  when (arity /= arity')
-                       (error $ "Arities of functions passed to "++
-                                "mkPipe do not match")
-                  let VarE f1Name = f1
-                      -- VarE f2Name = f2
-                  VarI _ t1 _ _ <- reify f1Name
-                  --VarI _ t2 _ _ <- reify f2Name
-                  let nameAux = mkName $ nameBase f1Name ++ "Aux"
-                      namePiped = mkName $ nameBase f1Name ++ "Piped"
-                      auxSpec = InlineSpec True False (Just (True, 1))
-                      pipeSpec = InlineSpec True True Nothing
-                      fAux = VarE nameAux
-                  names <- mapM newName (take (arity - 1) (repeat "x"))
-                  let app1 = foldl' AppE fAux (map VarE names)
-                      app2 = foldl' AppE f2 (map VarE names)
-                      pipe = AppE (AppE (VarE (mkName "pipeline")) app2) app1
-                  return [ SigD nameAux t1
-                         , FunD nameAux [Clause [] (NormalB f1) []]
-                         , PragmaD $ InlineP nameAux auxSpec
-                         --, SigD namePiped t2
-                         , FunD namePiped [Clause (map VarP names) 
-                                                  (NormalB pipe) []]
-                         , PragmaD $ InlineP namePiped pipeSpec ]
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
index 78fe686..871c30f 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
 module AI.CV.OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
                              LineType(..), RGB, drawLines) where
 import AI.CV.OpenCV.Core.CxCore
@@ -28,7 +27,7 @@ initFont face italic hscale vscale shear thickness ltype =
     do p <- malloc
        cvInitFont p face' hscale vscale shear thickness lt
        return p
-    where face' | italic = (fi $ fromEnum face) .|. italicFont
+    where face' | italic = fi (fromEnum face) .|. italicFont
                 | otherwise = fi $ fromEnum face
           lt = fi $ lineTypeEnum ltype
           fi = fromIntegral
@@ -66,7 +65,7 @@ prepFontAlt face italic hscale vscale shear thickness ltype =
                                   withCString msg $ \msg' ->
                                       cvPutText dst msg' x y f r g b
            {-# INLINE go #-}
-       return $ go
+       return go
 {-# INLINE prepFontAlt #-}
 
 putText :: (HasChannels c, HasDepth d) => 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 2ae7bfe..640e716 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -97,8 +97,10 @@ houghStandard rho theta threshold img = unsafePerformIO $
                                        x2 = clampX $ x0 - 10000*(-b)
                                        y2 = clampY $ y0 - 10000*a
                                    in ((x1,y1),(x2,y2))
-          clampX x = max 0 (min (truncate x) (width img - 1))
-          clampY y = max 0 (min (truncate y) (height img - 1))
+          w = fromIntegral (width img)
+          h = fromIntegral (height img)
+          clampX x = max 0 (min (truncate x) (w - 1))
+          clampY y = max 0 (min (truncate y) (h - 1))
 {-# NOINLINE houghStandard #-}
 
 -- |Line detection in a binary image using a probabilistic Hough
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index cb19b93..b967471 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -38,8 +38,9 @@ calcOpticalFlowBM prev curr blockSize shiftSize maxRange =
                                         (sw maxRange) (sh maxRange)
                                         0 (fromArr vxPtr) (fromArr vyPtr)
        return (velX, velY)
-    where w = (width prev - fst blockSize) `div` fst shiftSize
-          h = (height prev - snd blockSize) `div` snd shiftSize
+    where fi = fromIntegral
+          w = (fi (width prev) - fst blockSize) `div` fst shiftSize
+          h = (fi (height prev) - snd blockSize) `div` snd shiftSize
           sw = fromIntegral . fst -- size width
           sh = fromIntegral . snd -- size height
 {-# NOINLINE calcOpticalFlowBM #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index d35da2d..f3799bf 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -36,11 +36,11 @@ packPixels img =
                                             go (y+1) pSrc' pDst'
                             | otherwise = VG.unsafeFreeze v
                     go 0 0 0
-    where w = width img
-          h = height img
+    where w = fromIntegral $ width img
+          h = fromIntegral $ height img
           nc = imgChannels img
           w' = w * nc
-          stride = widthStep img
+          stride = fromIntegral $ widthStep img
           pix = pixels img
 {-# INLINE packPixels #-}
 
@@ -57,9 +57,9 @@ isolateChannel ch img =
                             | otherwise = do VM.unsafeWrite v p (get p3)
                                              go (x+1) (p+1) (p3+3) y
                     go 0 0 ch 0
-    where w = width img
-          h = height img
-          margin = widthStep img - (w  * 3)
+    where w = fromIntegral $ width img
+          h = fromIntegral $ height img
+          margin = fromIntegral (widthStep img) - (w  * 3)
           pix = pixels img
           get = V.unsafeIndex pix
 {-# INLINE isolateChannel #-}
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 06be1b2..8d493ec 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -34,7 +34,7 @@ instance ByteOrFloat d => SameOrByte d d where
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
-                   IO (CDouble)
+                   IO CDouble
 
 -- The worker function that calls c_cvThreshold.
 cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
@@ -50,13 +50,6 @@ cvThreshold threshold maxValue tType =
           tType' = fromIntegral tType
 {-# INLINE cvThreshold #-}
 
-cvThreshold1 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-               d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-               HIplImage MonoChromatic d2
-cvThreshold1 threshold maxValue tType = 
-    cvThreshold threshold maxValue tType
-{-# INLINE cvThreshold1 #-}
-
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
 cvThresholdOtsu :: Word8 -> Int -> HIplImage MonoChromatic Word8 ->
@@ -73,7 +66,7 @@ cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
 thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                    d1 -> d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
-thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
+thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
@@ -83,7 +76,7 @@ thresholdBinary th maxValue = cvThreshold1 th maxValue (fromEnum ThreshBinary)
 thresholdBinaryInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
                       d1 -> d1 -> HIplImage MonoChromatic d1 ->
                       HIplImage MonoChromatic d2
-thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
+thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
 
@@ -94,7 +87,7 @@ thresholdBinaryInv th maxValue = cvThreshold1 th maxValue tType
 thresholdTruncate :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                      d1 -> HIplImage MonoChromatic d1 ->
                      HIplImage MonoChromatic d2
-thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
+thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
@@ -103,7 +96,7 @@ thresholdTruncate threshold = cvThreshold1 threshold 0 (fromEnum ThreshTrunc)
 thresholdToZero :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                    d1 -> HIplImage MonoChromatic d1 ->
                    HIplImage MonoChromatic d2
-thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
+thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
@@ -112,7 +105,7 @@ thresholdToZero threshold = cvThreshold1 threshold 0 (fromEnum ThreshToZero)
 thresholdToZeroInv :: (ByteOrFloat d1, SameOrByte d1 d2) => 
                       d1 -> HIplImage MonoChromatic d1 ->
                       HIplImage MonoChromatic d2
-thresholdToZeroInv threshold = cvThreshold1 threshold 0 tType
+thresholdToZeroInv threshold = cvThreshold threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
 
diff --git a/src/AI/CV/OpenCV/Video.hs b/src/AI/CV/OpenCV/Video.hs
index 4933cf5..5a2a4bb 100644
--- a/src/AI/CV/OpenCV/Video.hs
+++ b/src/AI/CV/OpenCV/Video.hs
@@ -3,6 +3,7 @@
 module AI.CV.OpenCV.Video (createFileCapture, createFileCaptureLoop, 
                            createCameraCapture, createVideoWriter, 
                            FourCC, mpeg4CC) where
+import Data.Maybe (fromMaybe)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
 import AI.CV.OpenCV.Core.CxCore
@@ -12,7 +13,7 @@ import AI.CV.OpenCV.Core.HighGui
 -- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
 -- returns a 'Ptr' 'IplImage'.
 queryError :: Ptr CvCapture -> IO (Ptr IplImage)
-queryError = (maybe (error "Unable to capture frame") id `fmap`) . cvQueryFrame
+queryError = fmap (fromMaybe $ error "Unable to capture frame") . cvQueryFrame
 
 -- |If 'cvQueryFrame' returns 'Nothing', try rewinding the video and
 -- querying again. If it still fails, raise an error. When a non-null
@@ -58,7 +59,7 @@ createCameraCapture cam = do cvInit
                              capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
                                      (>>= fromPtr) . queryError)
-    where cam' = maybe (-1) id cam
+    where cam' = fromMaybe (-1) cam
 
 -- |4-character code for MPEG-4.
 mpeg4CC :: FourCC
diff --git a/src/Examples/VideoFunhouse/Rate.hs b/src/Examples/VideoFunhouse/Rate.hs
index ed825c4..9aeb564 100644
--- a/src/Examples/VideoFunhouse/Rate.hs
+++ b/src/Examples/VideoFunhouse/Rate.hs
@@ -7,38 +7,36 @@ trackRate :: IO (IO String)
 trackRate = do numFrames <- newIORef 0
                oldRate <- newIORef ""
                startTime <- getCurrentTime >>= newIORef
+               let reportRate = 
+                     do t <- getCurrentTime
+                        s <- readIORef startTime
+                        let dt = realToFrac $ diffUTCTime t s :: Float
+                            msg = printf "%.2f" (30.0 / dt)
+                        writeIORef startTime t
+                        writeIORef numFrames 0
+                        writeIORef oldRate msg
+                        return msg
+                   moveAlong n = writeIORef numFrames (n+1) >> readIORef oldRate
                return $ do n <- readIORef numFrames
-                           if n == 29 then
-                             do t <- getCurrentTime
-                                s <- readIORef startTime
-                                let dt = realToFrac $ diffUTCTime t s :: Float
-                                    msg = printf "%.2f" (30.0 / dt)
-                                writeIORef startTime t
-                                writeIORef numFrames 0
-                                writeIORef oldRate msg
-                                return msg
-                           else
-                             do writeIORef numFrames (n+1)
-                                readIORef oldRate
+                           if n == 29 then reportRate else moveAlong n
 
 perfMon :: IO (IO (), IO String, IO ())
 perfMon = do numFrames <- newIORef 0
              oldRate <- newIORef ""
              startTime <- getCurrentTime >>= newIORef
-             totalTime <- newIORef 0
+             totalTime <- newIORef (0::Double)
              let start = getCurrentTime >>= writeIORef startTime
                  stop = do t <- getCurrentTime
                            s <- readIORef startTime
                            let dt = realToFrac $ diffUTCTime t s :: Double
-                           modifyIORef totalTime (($!) (+ dt))
+                           modifyIORef totalTime ((+ dt) $!)
                            n <- readIORef numFrames
-                           if n == 29 then
-                             do oy <- readIORef totalTime
-                                msg <- readIORef totalTime >>= 
-                                       return . printf "%d" . (round::Double->Int) . (30.0 /)
-                                writeIORef numFrames 0
-                                writeIORef totalTime 0
-                                writeIORef oldRate msg
-                           else writeIORef numFrames (n+1)
-
+                           if n == 29 
+                             then do oy <- readIORef totalTime
+                                     msg <- formatMsg `fmap` readIORef totalTime
+                                     writeIORef numFrames 0
+                                     writeIORef totalTime 0
+                                     writeIORef oldRate msg
+                             else writeIORef numFrames (n+1)
              return (start, readIORef oldRate, stop)
+  where formatMsg = printf "%d" . (round::Double->Int) . (30.0 /)

From 93d46c5f79dc75d1167674a0c15a13e167aef606 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 2 Jun 2011 21:28:11 -0400
Subject: [PATCH 092/137] Fixed accidental restriction of fusion opportunities.

---
 src/AI/CV/OpenCV/Core/CVOp.hs | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index f334b20..6b77c1e 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -2,7 +2,7 @@
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
-import AI.CV.OpenCV.Core.CxCore (IplArrayType)
+import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
 import AI.CV.OpenCV.Core.HIplUtil
 import Control.Monad ((>=>), void)
 import Data.Monoid
@@ -11,17 +11,17 @@ import Foreign.ForeignPtr
 import System.IO.Unsafe
 
 -- |A CV operation is an IO function on a 'HIplImage'.
-newtype CVOp c d e = CVOp { op :: Ptr e -> IO () }
+newtype CVOp c d = CVOp { op :: Ptr CvArr -> IO () }
 
 cv :: forall a c d e.
       (HasChannels c, HasDepth d, IplArrayType e) => 
       (Ptr e -> IO a) -> HIplImage c d -> HIplImage c d
 cv = runCV . mkCVOp
-    where mkCVOp :: (Ptr e -> IO a) -> CVOp c d e
-          mkCVOp = CVOp . (void .)
+    where mkCVOp :: (Ptr e -> IO a) -> CVOp c d
+          mkCVOp f = CVOp (void . f. castPtr)
 {-# INLINE cv #-}
 
-instance Monoid (CVOp c d e) where
+instance Monoid (CVOp c d) where
   mempty = CVOp . const $ return ()
   CVOp f `mappend` CVOp g = CVOp (\x -> g x >> f x)
   {-# INLINE mappend #-}
@@ -33,7 +33,7 @@ withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f (castPtr x) >>
 
 -- |Run a 'CVOp'.
 runCV :: (HasChannels c, HasDepth d) => 
-         CVOp c d e -> HIplImage c d -> HIplImage c d
+         CVOp c d -> HIplImage c d -> HIplImage c d
 runCV = (unsafePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
@@ -48,25 +48,25 @@ cv2 :: forall a c1 d1 c2 d2 e.
         IplArrayType e) => 
        (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 -> HIplImage c2 d2
 cv2 = runBinOp . mkBinOp
-    where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp (c1,d1) (c2,d2) e
-          mkBinOp = BinOp . ((void .) .)
+    where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp (c1,d1) (c2,d2)
+          mkBinOp f = BinOp (\x y -> void (f (castPtr x) (castPtr y)))
 {-# INLINE cv2 #-}
 
-bi2unary :: BinOp (c,d) (c,d) e -> CVOp c d e
+bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
 bi2unary = CVOp . dupArg . binop
 
-unary2bi :: CVOp c d e -> BinOp (c,d) (c,d) e
+unary2bi :: CVOp c d -> BinOp (c,d) (c,d)
 unary2bi = BinOp . const . op
 
 (<>) :: Monoid m => m -> m -> m
 (<>) = mappend
 {-# INLINE (<>) #-}
 
-newtype BinOp a b c = 
-    BinOp { binop :: Ptr c -> Ptr c -> IO () }
+newtype BinOp a b = 
+    BinOp { binop :: Ptr CvArr -> Ptr CvArr -> IO () }
 
 -- Compose 'BinOp's for in-place mutation when the types allow it.
-cbop :: BinOp b b c -> BinOp a b c -> BinOp a b c
+cbop :: BinOp b b -> BinOp a b -> BinOp a b
 cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
 withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
@@ -78,10 +78,10 @@ withDst f img = do img2 <- mkHIplImage (width img) (height img)
                    return img2
     where go x = withHIplImage img (flip f (castPtr x) . castPtr)
 
-runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-             IplArrayType e) => 
-            BinOp (c1,d1) (c2,d2) e -> HIplImage c1 d1 -> HIplImage c2 d2
+runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
+            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 -> HIplImage c2 d2
 runBinOp = (unsafePerformIO .) . withDst . binop
+{-# NOINLINE runBinOp #-}
 
 {-# RULES "runCV/fuse"
     forall f g x. runCV f (runCV g x) = runCV (f <> g) x #-}

From 8545e2a0ccd81a1d112c6b8c2585f9262d273e79 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 3 Jun 2011 17:46:44 -0400
Subject: [PATCH 093/137] Documentation improvements.

---
 HOpenCV.cabal                     | 18 ++++++++----
 src/AI/CV/OpenCV/Core/CVOp.hs     | 23 +++++++++++++--
 src/AI/CV/OpenCV/Core/HIplUtil.hs | 47 ++++++++++++++++---------------
 src/AI/CV/OpenCV/GUI.hs           |  3 +-
 src/AI/CV/OpenCV/HighCV.hs        | 44 ++++++++++++++++++++---------
 5 files changed, 92 insertions(+), 43 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 8f01ddd..679aa54 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -12,16 +12,22 @@ description:
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6. Windows support is untested.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6.
    .
-   On Windows, OpenCV is assumed to be installed in the @C:\\OpenCV2.2@ directory.
+   Windows support is untested, but OpenCV is assumed to be installed in the @C:\\OpenCV2.2@ directory.
    .
    /Usage/
    .
-   The "AI.CV.OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations.
+   The "AI.CV.OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations. While the @Core@ modules contain to low-level OpenCV interfaces.
+   .
+   See @src\/Examples\/VideoFunhouse@ for an example application.
 build-type:         Simple
 cabal-version:      >= 1.2
-extra-source-files: src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+extra-source-files: src/AI/CV/OpenCV/Core/HOpenCV_wrap.h 
+                    src/Examples/VideoFunhouse/Makefile 
+                    src/Examples/VideoFunhouse/Rate.hs
+                    src/Examples/VideoFunhouse/VideoFunhouse.hs
+                    src/Examples/Closing/Closing.hs
 source-repository head
   type: git
   location: git://github.com/acowley/HOpenCV.git
@@ -29,6 +35,7 @@ source-repository head
 library
    exposed-modules:
       AI.CV.OpenCV.Core.CV
+      AI.CV.OpenCV.Core.CVOp 
       AI.CV.OpenCV.Core.CxCore
       AI.CV.OpenCV.Core.HighGui
       AI.CV.OpenCV.Core.HIplImage
@@ -40,6 +47,7 @@ library
       AI.CV.OpenCV.FloodFill
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
+      AI.CV.OpenCV.Drawing
       AI.CV.OpenCV.Motion
       AI.CV.OpenCV.Contours
       AI.CV.OpenCV.Threshold
@@ -48,7 +56,7 @@ library
       AI.CV.OpenCV.FeatureDetection
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-   other-modules: AI.CV.OpenCV.Core.CVOp AI.CV.OpenCV.Drawing
+   other-modules: 
    hs-Source-Dirs: src
    if os(windows)
      include-dirs: C:\\OpenCV2.2\\include
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index 6b77c1e..e42eaeb 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,6 +1,22 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
+--
+-- The 'cv' wrapper is intended for operations that take a single
+-- array argument, and mutate that array in-place. A canonical example
+-- is a function that draws lines on an image. Compositions of such
+-- operations may all mutate the same image in-place, but an argument
+-- given to the composition, or indeed given to a standalone operation
+-- of this variety, must be duplicated before being operated upon.
+--
+-- In contrast, the 'cv2' wrapper is for operations that take separate
+-- @src@ and @dst@ (source and destination) arguments. When the image
+-- types of these arguments are the same, it is possible to supply the
+-- same value for both arguments, thus avoiding an image allocation. A
+-- standalone operation of this variety, or a composition beginning
+-- with such an operation, must have a destination image
+-- allocated. This is cheaper than duplicating the input image as with
+-- operations wrapped by the `cv` combinator.
 module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
 import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
 import AI.CV.OpenCV.Core.HIplUtil
@@ -13,6 +29,9 @@ import System.IO.Unsafe
 -- |A CV operation is an IO function on a 'HIplImage'.
 newtype CVOp c d = CVOp { op :: Ptr CvArr -> IO () }
 
+-- |A wrapper for operations that mutate an array in-place. The input
+-- to such operations must be duplicated before being passed to the
+-- operation.
 cv :: forall a c d e.
       (HasChannels c, HasDepth d, IplArrayType e) => 
       (Ptr e -> IO a) -> HIplImage c d -> HIplImage c d
@@ -41,8 +60,8 @@ runCV = (unsafePerformIO .) . withClone . op
 dupArg :: (Ptr e -> Ptr e -> IO ()) -> Ptr e -> IO ()
 dupArg f = \x -> f x x
 
--- |Operations that want an argument /and/ a compatible destination
--- buffer, but don't need a clone of an input.
+-- |Wrapper for operations that want an argument /and/ a compatible
+-- destination buffer, but don't need a clone of an input.
 cv2 :: forall a c1 d1 c2 d2 e.
        (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
         IplArrayType e) => 
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index b100b41..ffe622b 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -2,7 +2,7 @@
              FlexibleInstances #-}
 -- |Functions for working with 'HIplImage's.
 module AI.CV.OpenCV.Core.HIplUtil
-    (isColor, isMono, imgChannels, withPixels, pixels,
+    (isColor, isMono, imgChannels, withPixelVector, pixels,
      fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
@@ -10,7 +10,7 @@ module AI.CV.OpenCV.Core.HIplUtil
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getROI, imageData, fromFile, unsafeWithHIplImage,
+     ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
 import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF, 
                                  CvSize(..), cloneImageF, cvCreateImage, 
@@ -32,12 +32,14 @@ import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode,
 import System.IO.Unsafe
 
 -- |This is a way to let the type checker know that you belieave an
--- image to be tri-chromatic.
+-- image to be tri-chromatic. If your image type can't be inferred any
+-- other way, this is an alternative to adding a type annotation.
 isColor :: HIplImage TriChromatic d -> HIplImage TriChromatic d
 isColor = id
 
 -- |This is a way to let the type checker know that you believe an
--- image to be monochromatic.
+-- image to be monochromatic. If your image type can't be inferred any
+-- other way, this is an alternative to adding a type annotation.
 isMono :: HIplImage MonoChromatic d -> HIplImage MonoChromatic d
 isMono = id
 
@@ -117,7 +119,8 @@ instance LoadableFormat MonoChromatic Word16 where
   loadFormat _ = fromPGM16
 
 -- |An overloaded image file loader. The number of color channels and
--- color depth parts of the returned image's type must be inferrable.
+-- color depth parts of the returned image's type must be inferrable
+-- as they control how the image file is loaded.
 fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (HIplImage c d)
 fromFile = loadFormat (undefined :: (c,d))
 
@@ -157,7 +160,7 @@ fromPGM16 fileName =
      hClose h
      return $ HIplImage 0 width height (fromIntegral numBytes) fp fp (2*width)
 
--- |Save a 'HIplImage' to the specified file.
+-- |Save an image to the specified file.
 toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
@@ -203,12 +206,12 @@ duplicateImagePtr = flip withHIplImage cloneImageF
 -- |Pass the given function a 'HIplImage' constructed from a width, a
 -- height, and a 'V.Vector' of pixel values. The new 'HIplImage' \'s
 -- pixel data is shared with the supplied 'V.Vector'.
-withPixels :: forall a c d r. 
-              (HasChannels c, Integral a, HasDepth d) =>
-              a -> a -> V.Vector d -> (HIplImage c d -> r) -> r
-withPixels w h pix f = if fromIntegral len == sz
-                       then f $ HIplImage 0 w' h' sz fp fp (w'*nc)
-                       else error "Length disagreement"
+withPixelVector :: forall a c d r. 
+                   (HasChannels c, Integral a, HasDepth d) =>
+                   a -> a -> V.Vector d -> (HIplImage c d -> r) -> r
+withPixelVector w h pix f = if fromIntegral len == sz
+                            then f $ HIplImage 0 w' h' sz fp fp (w'*nc)
+                            else error "Length disagreement"
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -245,9 +248,9 @@ fromGrayPixels :: (HasDepth d, Integral a) =>
                   a -> a -> V.Vector d -> HIplImage MonoChromatic d
 fromGrayPixels w h = isMono . fromPixels w h
 
--- |Helper function to explicitly type a vector of trichromatic pixel
--- data. Parameters are the output image's width, height, and pixel
--- content.
+-- |Helper function to explicitly type a vector of interleaved
+-- trichromatic pixel data. Parameters are the output image's width,
+-- height, and pixel content.
 fromColorPixels :: (HasDepth d, Integral a) =>
                    a -> a -> V.Vector d -> HIplImage TriChromatic d
 fromColorPixels w h = isColor . fromPixels w h
@@ -278,13 +281,13 @@ unsafeWithHIplImage :: (HasChannels c, HasDepth d) =>
 unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
 
 -- |Extract a rectangular region of interest from an image. Returns a
--- new image whose pixel data is copied from the ROI of the source
--- image. Parameters are the upper-left corner of the ROI in image
--- coordinates, the (width,height) of the ROI in pixels, and the
--- source 'HIplImage'.
-getROI :: (HasChannels c, HasDepth d) =>
-          (Int,Int) -> (Int,Int) -> HIplImage c d -> IO (HIplImage c d)
-getROI (rx,ry) (rw,rh) src = 
+-- new image whose pixel data is copied from the given rectangle of
+-- the source image. Parameters are the upper-left corner of the
+-- rectangle in image coordinates, the (width,height) of the rectangle
+-- in pixels, and the source 'HIplImage'.
+getRect :: (HasChannels c, HasDepth d) =>
+           (Int,Int) -> (Int,Int) -> HIplImage c d -> IO (HIplImage c d)
+getRect (rx,ry) (rw,rh) src = 
     do img <- mkHIplImage (fromIntegral rw) (fromIntegral rh)
        withForeignPtr (imageData img) $ \dst ->
          withForeignPtr (imageData src) $ \src ->
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index fb6072e..c4437f1 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -14,7 +14,8 @@ bool :: a -> a -> Bool -> a
 bool t _ True = t
 bool _ f False = f
 
--- |Simple window runner. Exits when any key is pressed.
+-- |Simple window runner. Takes an action that produces images to be
+-- shown in the window. Exits when any key is pressed.
 runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
 runWindow mkImg = newWindow 0 True >> go
     where go = do mkImg >>= flip withHIplImage (showImage 0)
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 640e716..6674e00 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -2,25 +2,40 @@
 -- operations will be performed in-place under composition. For
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
-module AI.CV.OpenCV.HighCV (erode, dilate, houghStandard, houghProbabilistic, 
-                            HIplImage, width, height, isColor, isMono,
-                            pixels, withPixels, fromGrayPixels, fromColorPixels,
+module AI.CV.OpenCV.HighCV (
+                            -- * Image Files
                             fromFile, fromFileGray, fromFileColor, 
-                            fromPGM16, toFile, fromPtr, normalize,
-                            withImagePixels, sampleLine, Connectivity(..), 
-                            fromPixels, resize, getROI, CvRect(..),
-                            cv_L2, cv_MinMax, Word8, Word16,
-                            InterpolationMethod(..), MonoChromatic, 
-                            TriChromatic, HasChannels, HasDepth,
-                            GrayImage, ColorImage, GrayImage16, 
+                            fromPGM16, toFile,
+                            -- * Image Properties
+                            width, height, isColor, isMono,
+                            -- * Image Construction
+                            fromPixels, fromGrayPixels, fromColorPixels, 
+                            fromPtr,
+                            -- * Image Data Accessors
+                            pixels, withPixelVector, withImagePixels, 
+                            sampleLine, getRect,
+                            -- * Image Processing
+                            erode, dilate, houghStandard, houghProbabilistic, 
+                            normalize, resize, 
                             module AI.CV.OpenCV.ColorConversion,
                             module AI.CV.OpenCV.Threshold,
                             module AI.CV.OpenCV.FloodFill,
                             module AI.CV.OpenCV.FeatureDetection,
+                            Connectivity(..), 
+                            CvRect(..),
+                            cv_L2, cv_MinMax, 
+                            InterpolationMethod(..), 
+                            -- * GUI and Drawing
+                            module AI.CV.OpenCV.GUI, 
                             module AI.CV.OpenCV.Drawing,
-                            module AI.CV.OpenCV.GUI,
-                            module AI.CV.OpenCV.Video)
-    where
+                            -- * Video
+                            module AI.CV.OpenCV.Video,
+                            -- * Image types
+                            HIplImage, MonoChromatic, TriChromatic, 
+                            HasChannels, HasDepth, 
+                            GrayImage, ColorImage, GrayImage16, 
+                            Word8, Word16
+    ) where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Drawing
@@ -155,6 +170,9 @@ resize method w h img =
        return img'
 {-# NOINLINE resize #-}
 
+-- |Normalize the range of color values in an image to the given
+-- range. Example usage with a grayscale image is @normalize cv_MinMax
+-- 0 255 img@
 normalize :: (HasChannels c, HasDepth d) => 
              ArrayNorm -> CDouble -> CDouble -> HIplImage c d -> HIplImage c d
 normalize ntype a b = cv2 $ \img dst -> 

From 6d65063f74708d47fac8b5b6f9325a9a032667cc Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 3 Jun 2011 19:42:56 -0400
Subject: [PATCH 094/137] Added a comment clarification about frame rate
 display to VideoFunhouse.

---
 src/Examples/VideoFunhouse/VideoFunhouse.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index e76667c..778f559 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -85,7 +85,9 @@ blueprint2slow x = add (neonEdges g) (fourTones g)
 -- situations, a camera may run at a lower rate to effect a longer
 -- exposure time. To still report a useful performance metric, the
 -- perfMon monitor counts only the time a frame is being processed and
--- drawn.
+-- drawn. Thus, the displayed framerate is the maximum theoretical
+-- rate the processing and display code could run at if the image
+-- capturing mechanism could feed it that fast.
 
 main = do args <- getArgs
           cam <- case args of

From 6109e4d54aa58d7502a920ea6895490dec37a35b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 9 Jun 2011 01:09:19 -0400
Subject: [PATCH 095/137] Mask out upper 16 bits of cvWaitKey return value to
 discard shift/event info.

---
 src/AI/CV/OpenCV/GUI.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index c4437f1..5ebe467 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -6,6 +6,7 @@ import AI.CV.OpenCV.Core.HIplImage
 import AI.CV.OpenCV.Core.HighGui
 import AI.CV.OpenCV.Core.CxCore (fromArr)
 import Control.Monad ((>=>))
+import Data.Bits ((.&.))
 import Data.Word (Word8)
 import Foreign.Ptr (castPtr)
 import Foreign.C.String (newCString)
@@ -53,4 +54,4 @@ namedWindow name flags =
 waitKey :: Int -> IO (Maybe Int)
 waitKey = cvWaitKey . fromIntegral >=> return . checkKey
   where checkKey (-1) = Nothing
-        checkKey x = Just (fromIntegral x)
+        checkKey x = Just (fromIntegral (x .&. 0xFF))

From 98fde6675283b9a9481ccbba8739cbca34f425b0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 9 Jun 2011 01:09:44 -0400
Subject: [PATCH 096/137] Add support for linking against OpenCV 2.1 using a
 cabal flag.

---
 HOpenCV.cabal                        | 10 +++++++++-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c |  5 +++++
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h |  5 +++++
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 679aa54..27d70b7 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -32,6 +32,10 @@ source-repository head
   type: git
   location: git://github.com/acowley/HOpenCV.git
 
+Flag OpenCV21
+  Description: Link against OpenCV 2.1
+  Default:     False
+
 library
    exposed-modules:
       AI.CV.OpenCV.Core.CV
@@ -63,7 +67,11 @@ library
      extra-lib-dirs:     C:\\OpenCV2.2\\bin
      extra-libraries: cxcore220, cv220, highgui220
    else
-     extra-libraries: opencv_core,opencv_imgproc,opencv_highgui
+     if flag(OpenCV21)
+       CC-Options:      "-DOCV21"
+       extra-libraries: cv highgui
+     else
+       extra-libraries: opencv_core,opencv_imgproc,opencv_highgui
    build-depends: base >=4 && <5, 
                   template-haskell,
                   allocated-processor >= 0.0.1, 
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index 88271c8..f2be1dd 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -1,6 +1,11 @@
+#ifdef OCV21
+#include <opencv/cv.h>
+#include <opencv/highgui.h>
+#else
 #include <opencv2/core/core_c.h>
 #include <opencv2/imgproc/imgproc_c.h>
 #include <opencv2/highgui/highgui_c.h>
+#endif
 
 #include <stdio.h>
 
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 72b05a4..6d4d698 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -1,5 +1,10 @@
+#ifdef OCV21
+#include <opencv/cv.h>
+#include <opencv/highgui.h>
+#else
 #include <opencv2/imgproc/imgproc_c.h>
 #include <opencv2/core/core_c.h>
+#endif
 
 void debug_print_image_header(IplImage *image);
 

From 75bd3fd723989ae201b3cffa75c378b0a5eb5cc9 Mon Sep 17 00:00:00 2001
From: unknown <acowley@.(none)>
Date: Thu, 9 Jun 2011 21:43:42 -0400
Subject: [PATCH 097/137] Fixed Windows library names.

---
 HOpenCV.cabal | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 27d70b7..540b0cf 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -63,9 +63,9 @@ library
    other-modules: 
    hs-Source-Dirs: src
    if os(windows)
-     include-dirs: C:\\OpenCV2.2\\include
-     extra-lib-dirs:     C:\\OpenCV2.2\\bin
-     extra-libraries: cxcore220, cv220, highgui220
+     include-dirs:	C:\\OpenCV2.2\\include
+     extra-lib-dirs:	C:\\OpenCV2.2\\bin
+     extra-libraries: 	opencv_core220,opencv_imgproc220,opencv_highgui220
    else
      if flag(OpenCV21)
        CC-Options:      "-DOCV21"

From 5571d4c7288284bc2150282e257a9871a48d232d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Thu, 9 Jun 2011 21:55:10 -0400
Subject: [PATCH 098/137] Updated notes about Windows compatibility.

---
 HOpenCV.cabal | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 540b0cf..7f21f3a 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -12,9 +12,7 @@ description:
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 10.04, Mac OS 10.5 and 10.6.
-   .
-   Windows support is untested, but OpenCV is assumed to be installed in the @C:\\OpenCV2.2@ directory.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 11.04, Mac OS 10.5 and 10.6, Windows 7.
    .
    /Usage/
    .

From 7b740f9e16d5ce68b62604013c2e28920c42d664 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 03:17:33 -0400
Subject: [PATCH 099/137] Added equalizeHist in the Histograms module.

---
 HOpenCV.cabal                  |  3 ++-
 README                         | 21 ---------------------
 README.md                      | 24 ++++++++++++++++++++++++
 src/AI/CV/OpenCV/Histograms.hs | 12 ++++++++++++
 4 files changed, 38 insertions(+), 22 deletions(-)
 delete mode 100644 README
 create mode 100644 README.md
 create mode 100644 src/AI/CV/OpenCV/Histograms.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 7f21f3a..ff7d824 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -56,6 +56,7 @@ library
       AI.CV.OpenCV.ArrayOps
       AI.CV.OpenCV.Filtering
       AI.CV.OpenCV.FeatureDetection
+      AI.CV.OpenCV.Histograms
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
    other-modules: 
@@ -76,4 +77,4 @@ library
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
                   vector == 0.7.*
-   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -O3 -funbox-strict-fields
+   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -O2 -funbox-strict-fields
diff --git a/README b/README
deleted file mode 100644
index 6ee8269..0000000
--- a/README
+++ /dev/null
@@ -1,21 +0,0 @@
-HOpenCV
--------
-
-OpenCV 2.2 bindings for Haskell.
-
-- Image color channel count and color depth are statically checked.
-
-- A functional interface is provided through the HighCV module.
-
-- When operations are directly composed, they will be performed
-  in-place where possible as the intermediate images are not
-  observable. GHC's optimizations must be enabled (e.g. -O2).
-
-- See `src/Examples` for example programs. In particular, the
-  `VideoFunhouse` executable demonstrates realtime image processing on
-  the video feed from a webcam. Fusion of in-place operations is
-  demonstrated along with light-weight parallelism.
-
-NOTE: Only a small part of OpenCV is currently wrapped.
-
-
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..a333025
--- /dev/null
+++ b/README.md
@@ -0,0 +1,24 @@
+# HOpenCV
+
+[OpenCV](http://opencv.willowgarage.com/wiki/) bindings for Haskell
+(tested with versions 2.1, 2.2, and 2.3).
+
+- Image color channel count and color depth are statically checked.
+
+- A functional interface is provided through the HighCV module.
+
+- When operations are directly composed, they will be performed
+  in-place where possible as the intermediate images are not
+  observable. GHC's optimizations must be enabled (e.g. -O2).
+
+- See
+  [src/Examples](https://github.com/acowley/HOpenCV/tree/master/src/Examples)
+  for example programs. In particular, the
+  [VideoFunhouse](https://github.com/acowley/HOpenCV/tree/master/src/Examples/VideoFunhouse)
+  executable demonstrates realtime image processing on either the
+  video feed from a webcam or a video file. Fusion of in-place
+  operations is demonstrated along with light-weight parallelism.
+
+NOTE: Only a small part of OpenCV is currently wrapped.
+
+
diff --git a/src/AI/CV/OpenCV/Histograms.hs b/src/AI/CV/OpenCV/Histograms.hs
new file mode 100644
index 0000000..23eab3a
--- /dev/null
+++ b/src/AI/CV/OpenCV/Histograms.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module AI.CV.OpenCV.Histograms (equalizeHist) where
+import Foreign.Ptr (Ptr)
+import AI.CV.OpenCV.Core.CxCore
+import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.CVOp
+
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvEqualizeHist"
+  c_cvEqualizeHist :: Ptr CvArr -> Ptr CvArr -> IO ()
+
+equalizeHist :: GrayImage -> GrayImage
+equalizeHist = cv $ \src -> c_cvEqualizeHist src src

From 5e34cd2970b818b72469acf4b51e944903819487 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 03:18:55 -0400
Subject: [PATCH 100/137] Added HSV color conversions.

---
 src/AI/CV/OpenCV/ColorConversion.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 75a6fb1..ffda5a6 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -2,7 +2,8 @@
 module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
      convertBGRToGray, convertRGBToGray,
-     convertBayerBgToBGR, convertBayerBgToRGB) where
+     convertBayerBgToBGR, convertBayerBgToRGB,
+     convertRGBToHSV, convertBGRToHSV, convertHSVToBGR) where
 import AI.CV.OpenCV.Core.CV
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
@@ -38,6 +39,21 @@ convertBayerBgToRGB :: HasDepth d =>
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
 {-# INLINE convertBayerBgToRGB #-}
 
+convertRGBToHSV :: HasDepth d =>
+                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertRGBToHSV = convertColor cv_RGB2HSV
+{-# INLINE convertRGBToHSV #-}
+
+convertBGRToHSV :: HasDepth d =>
+                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertBGRToHSV = convertColor cv_BGR2HSV
+{-# INLINE convertBGRToHSV #-}
+
+convertHSVToBGR :: HasDepth d =>
+                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertHSVToBGR = convertColor cv_HSV2BGR
+{-# INLINE convertHSVToBGR #-}
+
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
                 ColorConversion -> HIplImage c1 d -> HIplImage c2 d

From e609a03421cf48496cbfbd040386dbff92b3cc7c Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 03:19:49 -0400
Subject: [PATCH 101/137] Added isolateChannel and replaceChannel.

---
 src/AI/CV/OpenCV/ArrayOps.hs | 32 +++++++++++++++++++++++++++++++-
 1 file changed, 31 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 12971cf..6b08b9d 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -5,11 +5,14 @@ module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale,
                               cvOr, cvOrS, set, setROI, resetROI,
                               mul, mulS, add, addS, sub, subMask,
                               cmpS, avg, avgMask, cvNot,
-                              ComparisonOp(..)) where
+                              ComparisonOp(..), isolateChannel, 
+                              replaceChannel) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Marshal.Array
+import Foreign.Marshal.Alloc
+import Foreign.Storable (poke)
 import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..), CmpOp(..), 
                                  cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
@@ -281,3 +284,30 @@ foreign import ccall "opencv2/core/core_c.h cvNot"
 cvNot :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
 cvNot = cv2 $ \src dst -> c_cvNot src dst
 {-# INLINE cvNot #-}
+
+foreign import ccall "opencv2/core/core_c.h cvMixChannels"
+  cvMixChannels :: Ptr (Ptr CvArr) -> CInt -> Ptr (Ptr CvArr) -> CInt -> 
+                   Ptr CInt -> CInt -> IO ()
+
+-- |Isolate a specific channel from a trichromatic image.
+isolateChannel :: HasDepth d =>
+                  CInt -> HIplImage TriChromatic d -> HIplImage MonoChromatic d
+isolateChannel n = cv2 $ \src dst -> 
+                   alloca $ \p1 -> poke p1 src >>
+                                   (alloca $ \p2 ->
+                                     poke p2 dst >>
+                                     (withArray [n,0] $ \ft ->
+                                       cvMixChannels p1 1 p2 1 ft 1))
+
+-- |Replace a specific channel of a trichromatic image with the single
+-- channel from a monochromatic image.
+replaceChannel :: HasDepth d => CInt -> HIplImage MonoChromatic d -> 
+                  HIplImage TriChromatic d -> HIplImage TriChromatic d
+replaceChannel n c = cv2 $ \src dst -> 
+                     withHIplImage c $ \cp ->
+                       withArray [castPtr cp, src] $ \p1 -> 
+                         withArray [dst] $ \p2 ->
+                           withArray [0,n,1+n',n',1+n'',n''] $ \ft ->
+                             cvMixChannels p1 2 p2 1 ft 3
+  where n' = (n + 1) `rem` 3
+        n'' = (n + 2) `rem` 3

From b44482808a3df0dc1765f64db91c6cb4c2eb23b9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 03:21:06 -0400
Subject: [PATCH 102/137] Added saturation boost effect to VideoFunhouse.

---
 src/AI/CV/OpenCV/Core/HIplImage.hsc         |  2 +-
 src/AI/CV/OpenCV/Core/HIplUtil.hs           | 10 +++
 src/AI/CV/OpenCV/FeatureDetection.hs        |  1 +
 src/AI/CV/OpenCV/HighCV.hs                  |  9 ---
 src/AI/CV/OpenCV/Threshold.hs               | 70 ++++++++++++++-------
 src/Examples/PerfTest/Makefile              |  2 +-
 src/Examples/PerfTest/PerfTest.hs           | 10 +--
 src/Examples/VideoFunhouse/Makefile         |  2 +-
 src/Examples/VideoFunhouse/VideoFunhouse.hs | 23 ++++++-
 9 files changed, 86 insertions(+), 43 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 7885888..0f0900d 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -80,7 +80,7 @@ instance HasDepth Double where
     toDouble = id
     fromDouble = id
 
-class HasDepth a => ByteOrFloat a where
+class (HasDepth a, Num a) => ByteOrFloat a where
 instance ByteOrFloat Word8 where
 instance ByteOrFloat Float where
 
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index ffe622b..91e8a2c 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -9,6 +9,7 @@ module AI.CV.OpenCV.Core.HIplUtil
      withDuplicateImage, withCompatibleImage, pipeline,
      HIplImage, mkHIplImage, width, height, mkBlackImage,
      withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
+     GrayImage, GrayImage16, ColorImage,
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
@@ -31,6 +32,15 @@ import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode,
                   IOMode(..))
 import System.IO.Unsafe
 
+-- |Grayscale 8-bit (per-pixel) image type.
+type GrayImage = HIplImage MonoChromatic Word8
+
+-- |Grayscale 16-bit (per-pixel) image type.
+type GrayImage16 = HIplImage MonoChromatic Word16
+
+-- |Color 8-bit (per-color) image type.
+type ColorImage = HIplImage TriChromatic Word8
+
 -- |This is a way to let the type checker know that you belieave an
 -- image to be tri-chromatic. If your image type can't be inferred any
 -- other way, this is an alternative to adding a type annotation.
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 5e43cb9..23b6906 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -52,5 +52,6 @@ canny :: HasDepth d =>
          HIplImage MonoChromatic d
 canny t1 t2 aperture = 
     cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
+    --cv $ \src -> c_cvCanny src src (rf t1) (rf t2) (fi aperture)
   where rf = realToFrac
         fi = fromIntegral
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 6674e00..ffa706e 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -53,15 +53,6 @@ import AI.CV.OpenCV.FloodFill
 import AI.CV.OpenCV.FeatureDetection
 import AI.CV.OpenCV.Video
 
--- |Grayscale 8-bit (per-pixel) image type.
-type GrayImage = HIplImage MonoChromatic Word8
-
--- |Grayscale 16-bit (per-pixel) image type.
-type GrayImage16 = HIplImage MonoChromatic Word16
-
--- |Color 8-bit (per-color) image type.
-type ColorImage = HIplImage TriChromatic Word8
-
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
 erode :: (HasChannels c, HasDepth d) =>
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 8d493ec..dbe6dda 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, 
-             MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, TypeFamilies,
+             MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when used in compositions.
 module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
@@ -8,6 +8,7 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdBinaryOtsu, thresholdBinaryOtsuInv,
                                thresholdTruncateOtsu,
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
+import Control.Monad (void)
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
@@ -28,6 +29,7 @@ data ThresholdType = ThreshBinary
 -- destination image must be either the same pixel type as the source,
 -- or 8-bit. This means that images of float pixels can be converted
 -- to 8-bit images during the thresholding process.
+
 class (HasDepth d1, HasDepth d2) => SameOrByte d1 d2 where
 instance SameOrByte Float Word8 where
 instance ByteOrFloat d => SameOrByte d d where
@@ -36,11 +38,37 @@ foreign import ccall "opencv2/imgproc/imgproc_c.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                    IO CDouble
 
+class ByteOrFloat a => Thresholdable a b where
+  doThreshold :: a -> a -> Int -> 
+                 HIplImage MonoChromatic a -> 
+                 HIplImage MonoChromatic b
+
+instance Thresholdable Word8 Word8 where
+  doThreshold = cvThreshold1
+  {-# INLINE doThreshold #-}
+
+instance Thresholdable Float Float where
+  doThreshold = cvThreshold1
+  {-# INLINE doThreshold #-}
+
+instance Thresholdable Float Word8 where
+  doThreshold = cvThreshold2
+  {-# INLINE doThreshold #-}
+  
+cvThreshold1 :: ByteOrFloat a => a -> a -> Int -> 
+                HIplImage MonoChromatic a -> HIplImage MonoChromatic a
+cvThreshold1 threshold maxValue tType =
+  cv $ \src -> void $ c_cvThreshold src src threshold' maxValue' tType'
+  where threshold' = realToFrac . toDouble $ threshold
+        maxValue' = realToFrac . toDouble $ maxValue
+        tType' = fromIntegral tType
+{-# INLINE cvThreshold1 #-}
+
 -- The worker function that calls c_cvThreshold.
-cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-               d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-               HIplImage MonoChromatic d2
-cvThreshold threshold maxValue tType = 
+cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
+                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
+                HIplImage MonoChromatic d2
+cvThreshold2 threshold maxValue tType = 
     cv2 $ \src dst ->
         do _r <- c_cvThreshold src dst threshold' maxValue' tType'
            return ()
@@ -48,6 +76,11 @@ cvThreshold threshold maxValue tType =
     where threshold' = realToFrac . toDouble $ threshold
           maxValue' = realToFrac . toDouble $ maxValue
           tType' = fromIntegral tType
+{-# INLINE cvThreshold2 #-}
+
+cvThreshold :: Thresholdable d1 d2 => d1 -> d1 -> Int -> 
+               HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+cvThreshold = doThreshold
 {-# INLINE cvThreshold #-}
 
 -- Use Otsu's method to determine an optimal threshold value which is
@@ -63,9 +96,8 @@ cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
 -- @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
-thresholdBinary :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-                   d1 -> d1 -> HIplImage MonoChromatic d1 ->
-                   HIplImage MonoChromatic d2
+thresholdBinary :: Thresholdable d1 d2 => d1 -> d1 -> 
+                   HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
 thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
@@ -73,9 +105,8 @@ thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 -- the @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
-thresholdBinaryInv :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-                      d1 -> d1 -> HIplImage MonoChromatic d1 ->
-                      HIplImage MonoChromatic d2
+thresholdBinaryInv :: Thresholdable d1 d2 => d1 -> d1 -> 
+                      HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
 thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
@@ -84,27 +115,24 @@ thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
-thresholdTruncate :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                     d1 -> HIplImage MonoChromatic d1 ->
-                     HIplImage MonoChromatic d2
+thresholdTruncate :: Thresholdable d1 d2 => d1 ->
+                     HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
 thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
-thresholdToZero :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                   d1 -> HIplImage MonoChromatic d1 ->
-                   HIplImage MonoChromatic d2
+thresholdToZero :: Thresholdable d1 d2 => d1 ->
+                   HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
 thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
-thresholdToZeroInv :: (ByteOrFloat d1, SameOrByte d1 d2) => 
-                      d1 -> HIplImage MonoChromatic d1 ->
-                      HIplImage MonoChromatic d2
+thresholdToZeroInv :: Thresholdable d1 d2 => d1 ->
+                      HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
 thresholdToZeroInv threshold = cvThreshold threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
diff --git a/src/Examples/PerfTest/Makefile b/src/Examples/PerfTest/Makefile
index 500f191..5deeae6 100644
--- a/src/Examples/PerfTest/Makefile
+++ b/src/Examples/PerfTest/Makefile
@@ -1,4 +1,4 @@
 all:	PerfTest.hs
 	ghc -O2 PerfTest.hs -ddump-simpl-stats -fforce-recomp -rtsopts -threaded -fspec-constr-count=15
 
-# Suggested RTS options: ./PerfTest +RTS -s -A8M -N
\ No newline at end of file
+# Suggested RTS options: ./PerfTest +RTS -A4M
diff --git a/src/Examples/PerfTest/PerfTest.hs b/src/Examples/PerfTest/PerfTest.hs
index 3854d15..ecc4918 100644
--- a/src/Examples/PerfTest/PerfTest.hs
+++ b/src/Examples/PerfTest/PerfTest.hs
@@ -1,13 +1,9 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 import AI.CV.OpenCV.HighCV
-import AI.CV.OpenCV.Core.HIplImage
 import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
 import Control.Parallel
 import Criterion.Main
-import System.IO.Unsafe
-import Control.DeepSeq
-import Foreign.ForeignPtr
 
 -- Morphological closing
 close :: GrayImage -> GrayImage
@@ -33,7 +29,7 @@ fourTones g = cvOr light dark
 
 -- Smoothed Canny edges.
 neonEdges :: GrayImage -> ColorImage
-neonEdges = convertGrayToRGB . smoothGaussian 3 . dilate 1 . canny 70 110 3
+neonEdges = convertGrayToRGB . smoothGaussian 5. dilate 1 . canny 70 110 3
 {-# INLINE neonEdges #-}
 
 -- A blueprint effect.
@@ -50,9 +46,7 @@ blueprintSlow x = add (fourTones g) (neonEdges g)
     where g = convertRGBToGray x
 {-# INLINE blueprintSlow #-}
 
-instance NFData ColorImage where
-    rnf img = unsafePerformIO (touchForeignPtr $ imageData img) `seq` ()
-
+main :: IO ()
 main = do img <- fromFile "lena.jpg"
           defaultMain [ 
               bench "blueprint" $ whnf blueprint img
diff --git a/src/Examples/VideoFunhouse/Makefile b/src/Examples/VideoFunhouse/Makefile
index 875dae5..fc38dbf 100644
--- a/src/Examples/VideoFunhouse/Makefile
+++ b/src/Examples/VideoFunhouse/Makefile
@@ -1,2 +1,2 @@
 all:	VideoFunhouse.hs Rate.hs
-	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=15 -with-rtsopts="-A8M -N"
+	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=15 -with-rtsopts="-A4M"
diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index 778f559..6de52de 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -5,6 +5,7 @@
 import AI.CV.OpenCV.HighCV
 import AI.CV.OpenCV.ArrayOps
 import AI.CV.OpenCV.Filtering
+import AI.CV.OpenCV.Histograms
 import Control.Applicative
 import Control.Parallel
 import System.Environment (getArgs)
@@ -38,13 +39,27 @@ twoTone g = light t `cvOr` dark t
 -- Smoothed Canny edges.
 neonEdges :: GrayImage -> ColorImage
 neonEdges = convertGrayToRGB . smoothGaussian 3 . dilate 1 . canny 70 110 3
+
+neonEdges' :: ColorImage -> ColorImage
+neonEdges' x = hedges `cvOr` sedges `cvAnd` (cvNot vedges)
+  where hsv = convertBGRToHSV x
+        glow = convertGrayToRGB . smoothGaussian 5 . dilate 1 . canny 70 110 3
+        hedges = cvAndS (0,255,255) . glow . isolateChannel 0 $ hsv
+        sedges = cvAndS (0,255,120) . glow . isolateChannel 1 $ hsv
+        vedges = convertGrayToRGB . thresholdBinary 200 255 . smoothGaussian 5 . dilate 1 . canny 70 110 3 . isolateChannel 2 $ hsv
 {-# INLINE neonEdges #-}
 
+-- Boost saturation
+boostSat x = convertHSVToBGR $ replaceChannel 1 s' hsv
+  where hsv = convertBGRToHSV x
+        s' = convertScale 2.0 0 . isolateChannel 1 $ hsv
+{-# INLINE boostSat #-}
+
 -- A two-tone blueprint effect.
 blueprint x = toned `par` neon `pseq` add neon toned
   where g = convertRGBToGray x
         toned = twoTone g
-        neon = neonEdges g
+        neon = neonEdges' x --g
 {-# INLINE blueprint #-}
 
 -- No parallelism
@@ -112,6 +127,7 @@ main = do args <- getArgs
               checkKey b _ 53 = go b blueprintSlow   -- 5
               checkKey b _ 54 = go b blueprint2      -- 6
               checkKey b _ 55 = go b blueprint2slow  -- 7
+              checkKey b _ 56 = go b boostSat        -- 8
               checkKey b p 102 = go (not b) p
               checkKey _ _ 27 = close >> exitSuccess
               checkKey b p _ = go b p
@@ -130,7 +146,9 @@ main = do args <- getArgs
           go False id
 
 showHelp :: IO ()
-showHelp = do p "Press 'f' to toggle framerate display"
+showHelp = do p "Usage: VideoFunhouse [file]"
+              p ""
+              p "Press 'f' to toggle framerate display"
               p "  The rate is computed from the per-frame processing time."
               p "  Lighting conditions and the specific camera used will"
               p "  determine the actual rate at which frames are acquired."
@@ -143,6 +161,7 @@ showHelp = do p "Press 'f' to toggle framerate display"
               p " 5 - Two-tone blueprint effect without par annotations"
               p " 6 - A four-tone blueprint effect"
               p " 7 - Four-tone blueprint effect without par annotations"
+              p " 8 - Saturation boost"
               p ""
               p "Press Esc to exit."
     where p = putStrLn

From 85e2e64d7b795a43784b14cd935872f9cc9d8674 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 03:22:09 -0400
Subject: [PATCH 103/137] Improved README wording.

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index a333025..30ed590 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 # HOpenCV
 
 [OpenCV](http://opencv.willowgarage.com/wiki/) bindings for Haskell
-(tested with versions 2.1, 2.2, and 2.3).
+(tested with OpenCV 2.1, 2.2, and 2.3).
 
 - Image color channel count and color depth are statically checked.
 

From c7a3ca09e98e314acad89fe56201d9ed5d650efe Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 14:37:33 -0400
Subject: [PATCH 104/137] Added ROI existence to image type to aid in static
 dispatching to ROI-overwriting in-place updates when possible.

---
 src/AI/CV/OpenCV/ArrayOps.hs                 | 159 +++++++++++--------
 src/AI/CV/OpenCV/ColorConversion.hs          |  52 +++---
 src/AI/CV/OpenCV/Core/CVOp.hs                | 104 +++++++++---
 src/AI/CV/OpenCV/Core/CxCore.hsc             |  11 +-
 src/AI/CV/OpenCV/Core/HIplImage.hsc          | 150 ++++++++++++++---
 src/AI/CV/OpenCV/Core/HIplUtil.hs            | 117 +++++++-------
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c         |   9 ++
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h         |   1 +
 src/AI/CV/OpenCV/Drawing.hs                  |  16 +-
 src/AI/CV/OpenCV/FeatureDetection.hs         |  22 +--
 src/AI/CV/OpenCV/Filtering.hsc               |  10 +-
 src/AI/CV/OpenCV/FloodFill.hsc               |   6 +-
 src/AI/CV/OpenCV/GUI.hs                      |   9 +-
 src/AI/CV/OpenCV/HighCV.hs                   |  29 ++--
 src/AI/CV/OpenCV/Motion.hsc                  |   8 +-
 src/AI/CV/OpenCV/PixelUtils.hs               |   8 +-
 src/AI/CV/OpenCV/Threshold.hs                |  99 +++++++-----
 src/AI/CV/OpenCV/Video.hs                    |  10 +-
 src/Examples/{Closing => OneOffs}/Closing.hs |   0
 src/Examples/OneOffs/EqualizeCenter.hs       |  12 ++
 src/Examples/{Closing => OneOffs}/input.png  | Bin
 src/Examples/VideoFunhouse/VideoFunhouse.hs  |  11 +-
 22 files changed, 536 insertions(+), 307 deletions(-)
 rename src/Examples/{Closing => OneOffs}/Closing.hs (100%)
 create mode 100644 src/Examples/OneOffs/EqualizeCenter.hs
 rename src/Examples/{Closing => OneOffs}/input.png (100%)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 6b08b9d..b0f87fc 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables #-}
+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables,
+             FlexibleContexts #-}
 -- |Array operations.
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
                               cvAnd, andMask, scaleAdd, cvAndS,
                               cvOr, cvOrS, set, setROI, resetROI,
                               mul, mulS, add, addS, sub, subMask,
-                              cmpS, avg, avgMask, cvNot,
+                              cmpS, avg, avgMask, cvNot, withROI,
                               ComparisonOp(..), isolateChannel, 
                               replaceChannel) where
 import Data.Word (Word8)
@@ -14,19 +15,22 @@ import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc
 import Foreign.Storable (poke)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.Core.CxCore (CvArr, IplImage, CvRect(..), CmpOp(..), 
+import AI.CV.OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), 
                                  cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.HIplImage (addROI, resetROI)
 import AI.CV.OpenCV.Core.CVOp
 
+type M = MonoChromatic
+
 foreign import ccall "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
-          IsCvScalar s, s ~ CvScalar c d) =>
-         s -> HIplImage c d -> HIplImage c d
+          IsCvScalar s, s ~ CvScalar c d, InplaceROI r c d c d) =>
+         s -> HIplImage c d r -> HIplImage c d r
 subRS value = cv2 $ \src dst -> c_cvSubRS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar value
 {-# INLINE subRS #-}
@@ -35,8 +39,8 @@ foreign import ccall "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
-absDiff :: (HasChannels c, HasDepth d) => 
-           HIplImage c d -> HIplImage c d -> HIplImage c d
+absDiff :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+           HIplImage c d r -> HIplImage c d r -> HIplImage c d r
 absDiff src1 = cv2 $ \src2 dst -> 
                withHIplImage src1 $ \src1' ->
                  c_cvAbsDiff (castPtr src1') src2 dst
@@ -52,13 +56,13 @@ foreign import ccall "opencv2/core/core_c.h cvConvertScale"
 -- the channels of multi-channel arrays are processed
 -- independentally. Parameters are @scale@, @shift@, and the source
 -- 'HIplImage'.
-convertScale :: (HasChannels c, HasDepth d1, HasDepth d2) =>
-                Double -> Double -> HIplImage c d1 -> 
-                HIplImage c d2
-convertScale scale shift  = cv2 $ \src dst ->
-                            c_cvConvertScale src dst
-                                             (realToFrac scale) 
-                                             (realToFrac shift)
+convertScale :: (HasChannels c, HasDepth d1, HasDepth d2, ImgBuilder r,
+                 InplaceROI r c d1 c d2) =>
+                Double -> Double -> HIplImage c d1 r -> 
+                HIplImage c d2 r
+convertScale scale shift = cv2 $ \src dst -> 
+                           c_cvConvertScale src dst (rf scale) (rf shift)
+  where rf = realToFrac
 {-# INLINE convertScale #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAnd"
@@ -69,9 +73,10 @@ foreign import ccall "opencv2/core/core_c.h cvAnd"
 -- specifies the elements of the result that will be computed via the
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
-andMask :: (HasChannels c, HasDepth d) => 
-           HIplImage MonoChromatic Word8 -> HIplImage c d ->  
-           HIplImage c d -> HIplImage c d
+andMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
+            InplaceROI r3 c d c d) => 
+           HIplImage MonoChromatic Word8 r1 -> HIplImage c d r2 ->  
+           HIplImage c d r3 -> HIplImage c d r3
 andMask mask src1 = cv2 $ \src2 dst -> 
                     withHIplImage src1 $ \src1' -> 
                         withHIplImage mask $ \mask' ->
@@ -79,8 +84,8 @@ andMask mask src1 = cv2 $ \src2 dst ->
 {-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
-cvAnd :: (HasChannels c, HasDepth d) => 
-          HIplImage c d -> HIplImage c d ->  HIplImage c d
+cvAnd :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+          HIplImage c d r1 -> HIplImage c d r2 ->  HIplImage c d r2
 cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
              c_cvAnd (castPtr src1') src2 dst nullPtr
 {-# INLINE cvAnd #-}
@@ -91,8 +96,8 @@ foreign import ccall "opencv2/core/core_c.h cvAndS"
 
 -- |Per-element bit-wise conjunction of an array and a scalar. 
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
-           s ~ CvScalar c d) => 
-          s -> HIplImage c d -> HIplImage c d
+           s ~ CvScalar c d, InplaceROI r c d c d) => 
+          s -> HIplImage c d r -> HIplImage c d r
 cvAndS s = cv2 $ \img dst -> c_cvAndS img r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar s
 {-# INLINE cvAndS #-}
@@ -104,8 +109,9 @@ foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
 -- |Calculate the sum of a scaled array and another array. @scaleAdd
 -- src1 s src2@ computes @dst[i] = s*src1[i] + src2[i]@
 scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
-               s ~ CvScalar c d, IsCvScalar s) => 
-              HIplImage c d -> s -> HIplImage c d -> HIplImage c d
+             s ~ CvScalar c d, IsCvScalar s, ImgBuilder r1, 
+             InplaceROI r2 c d c d) => 
+            HIplImage c d r1 -> s -> HIplImage c d r2 -> HIplImage c d r2
 scaleAdd src1 s = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
                       c_cvScaleAdd (castPtr src1') r g b a src2 dst
@@ -119,8 +125,8 @@ cvMulHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Double -> IO ()
 cvMulHelper src1 src2 dst s = c_cvMul src1 src2 dst (realToFrac s)
 
 -- |Per-element product of two arrays.
-mul :: (HasChannels c, HasDepth d) => 
-       HIplImage c d -> HIplImage c d -> HIplImage c d
+mul :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 mul src1 = cv2 $ \src2 dst -> 
            withHIplImage src1 $ \src1' ->
                cvMulHelper (castPtr src1') src2 dst 1
@@ -128,8 +134,8 @@ mul src1 = cv2 $ \src2 dst ->
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
-mulS :: (HasChannels c, HasDepth d) => 
-        Double -> HIplImage c d -> HIplImage c d -> HIplImage c d
+mulS :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+        Double -> HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 mulS scale src1 = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
                       cvMulHelper (castPtr src1') src2 dst scale
@@ -139,8 +145,8 @@ foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum.
-add :: (HasChannels c, HasDepth d) => 
-       HIplImage c d -> HIplImage c d -> HIplImage c d
+add :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 add src1 = cv2 $ \src2 dst ->
            withHIplImage src1 $ \src1' ->
                c_cvAdd (castPtr src1') src2 dst nullPtr
@@ -151,8 +157,9 @@ foreign import ccall "opencv2/core/core_c.h cvAddS"
               Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Computes the sum of an array and a scalar.
-addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-        s -> HIplImage c d -> HIplImage c d
+addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+         InplaceROI r c d c d) => 
+        s -> HIplImage c d r -> HIplImage c d r
 addS scalar = cv2 $ \src dst -> c_cvAddS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE addS #-}
@@ -161,8 +168,8 @@ foreign import ccall "opencv2/core/core_c.h cvSub"
   c_cvSub :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element difference.
-sub :: (HasChannels c, HasDepth d) =>
-       HIplImage c d -> HIplImage c d -> HIplImage c d
+sub :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) =>
+       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 sub img1 = cv2 $ \img2 dst ->
            withHIplImage img1 $ \img1' -> 
                c_cvSub (castPtr img1') img2 dst nullPtr
@@ -172,9 +179,10 @@ sub img1 = cv2 $ \img2 dst ->
 -- img1@ computes @dst[i] = img1[i] - img2[i] if mask[i]@. The idea is
 -- that @dst@ is the same as @img1@ everywhere @mask@ is zero. This
 -- permits in-place updating of @img1@.
-subMask :: (HasChannels c, HasDepth d) =>
-           HIplImage c d -> HIplImage MonoChromatic Word8 -> HIplImage c d -> 
-           HIplImage c d
+subMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
+            InplaceROI r3 c d c d) =>
+           HIplImage c d r1 -> HIplImage MonoChromatic Word8 r2 -> HIplImage c d r3 -> 
+           HIplImage c d r3
 subMask img2 mask = cv $ \img1 ->
                     withHIplImage mask $ \mask' -> 
                         withHIplImage img2 $ \img2' ->
@@ -185,8 +193,8 @@ foreign import ccall "opencv2/core/core_c.h cvOr"
   c_cvOr :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise disjunction of two arrays
-cvOr :: (HasChannels c, HasDepth d) =>
-        HIplImage c d -> HIplImage c d -> HIplImage c d
+cvOr :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) =>
+        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 cvOr img1 = cv2 $ \img2 dst ->
             withHIplImage img1 $ \img1' -> 
                 c_cvOr (castPtr img1') img2 dst nullPtr
@@ -197,8 +205,9 @@ foreign import ccall "opencv2/core/core_c.h cvOrS"
              Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
-cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-         s -> HIplImage c d -> HIplImage c d
+cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+          InplaceROI r c d c d) => 
+         s -> HIplImage c d r -> HIplImage c d r
 cvOrS scalar = cv2 $ \src dst -> c_cvOrS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE cvOrS #-}
@@ -208,28 +217,42 @@ foreign import ccall "opencv2/core/core_c.h cvSet"
              Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
-set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-       s -> HIplImage c d -> HIplImage c d
+set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+        InplaceROI r c d c d) => 
+       s -> HIplImage c d r -> HIplImage c d r
 set scalar = cv $ \src -> c_cvSet src r g b a nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE set #-}
 
-foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
-  c_cvSetImageROI :: Ptr IplImage -> CInt -> CInt -> CInt -> CInt -> IO ()
-
-foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
-  c_cvResetImageROI :: Ptr IplImage -> IO ()
-
 -- |Set an image's region-of-interest.
 setROI :: (HasChannels c, HasDepth d) => 
-          CvRect -> HIplImage c d -> HIplImage c d
-setROI (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
+          CvRect -> HIplImage c d r -> HIplImage c d HasROI
+setROI = addROI
 {-# INLINE setROI #-}
 
--- |Clear any region-of-interest set for an image.
-resetROI :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
-resetROI = cv $ \img -> c_cvResetImageROI img
-{-# INLINE resetROI #-}
+setROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
+            CvRect -> HIplImage c d r -> HIplImage c d HasROI
+setROICV (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
+{-# INLINE setROICV #-}
+
+-- -- |Clear any region-of-interest set for an image.
+--resetROI :: (HasChannels c, HasDepth d) => HIplImage c d r -> HIplImage c d NoROI
+--resetROI = removeROI
+-- {-# INLINE resetROI #-}
+
+resetROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
+              HIplImage c d r -> HIplImage c d NoROI
+resetROICV = cv $ \img -> c_cvResetImageROI img
+{-# INLINE resetROICV #-}
+
+-- |Restrict an operation to a specific region-of-interest. This
+-- operation fuses.
+withROI :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
+            ImgBuilder r, ImgBuilder r2) => 
+           CvRect -> (HIplImage c1 d1 HasROI -> HIplImage c2 d2 r2) -> 
+           HIplImage c1 d1 r -> HIplImage c2 d2 NoROI
+withROI r f = resetROICV . f . setROICV r
+{-# INLINE withROI #-}
 
 foreign import ccall "opencv2/core/core_c.h cvCmpS"
   c_cvCmpS :: Ptr CvArr -> CDouble -> Ptr CvArr -> CInt -> IO ()
@@ -245,9 +268,9 @@ cmpToCmp CmpLE = unCmpOp cmpLE
 cmpToCmp CmpNE = unCmpOp cmpNE
 
 -- |Per-element comparison of an array and a scalar.
-cmpS :: HasDepth d => 
-        ComparisonOp -> d -> HIplImage MonoChromatic d -> 
-        HIplImage MonoChromatic Word8
+cmpS :: (HasDepth d, InplaceROI r M d M Word8) => 
+        ComparisonOp -> d -> HIplImage MonoChromatic d r -> 
+        HIplImage MonoChromatic Word8 r
 cmpS op v = cv2 $ \src dst ->
             c_cvCmpS src v' dst (cmpToCmp op)
     where v' = realToFrac . toDouble $ v
@@ -263,16 +286,17 @@ avgWorker img mask = allocaArray 4 $
                                 return $ fromCvScalar (r,g,b,a)
 
 -- |Calculates the mean independently for each channel.
-avg :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-       HIplImage c d -> CvScalar c d
+avg :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, ImgBuilder r) => 
+       HIplImage c d r -> CvScalar c d
 avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr . castPtr
 {-# NOINLINE avg #-}
 
 -- |@avgMask img mask@ calculates the mean independently for each
 -- channel for each element of the source array whose entry in @mask@
 -- is non-zero.
-avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d) => 
-           HIplImage c d -> HIplImage MonoChromatic Word8 -> CvScalar c d
+avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+            ImgBuilder r1, ImgBuilder r2) => 
+           HIplImage c d r1 -> HIplImage MonoChromatic Word8 r2 -> CvScalar c d
 avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
                    withHIplImage mask $ avgWorker (castPtr src) . castPtr
 {-# NOINLINE avgMask #-}
@@ -281,7 +305,8 @@ foreign import ccall "opencv2/core/core_c.h cvNot"
   c_cvNot :: Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise inversion.
-cvNot :: (HasChannels c, HasDepth d) => HIplImage c d -> HIplImage c d
+cvNot :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+         HIplImage c d r -> HIplImage c d r
 cvNot = cv2 $ \src dst -> c_cvNot src dst
 {-# INLINE cvNot #-}
 
@@ -290,8 +315,8 @@ foreign import ccall "opencv2/core/core_c.h cvMixChannels"
                    Ptr CInt -> CInt -> IO ()
 
 -- |Isolate a specific channel from a trichromatic image.
-isolateChannel :: HasDepth d =>
-                  CInt -> HIplImage TriChromatic d -> HIplImage MonoChromatic d
+isolateChannel :: (HasDepth d, InplaceROI r TriChromatic d M d) =>
+                  CInt -> HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
 isolateChannel n = cv2 $ \src dst -> 
                    alloca $ \p1 -> poke p1 src >>
                                    (alloca $ \p2 ->
@@ -301,8 +326,10 @@ isolateChannel n = cv2 $ \src dst ->
 
 -- |Replace a specific channel of a trichromatic image with the single
 -- channel from a monochromatic image.
-replaceChannel :: HasDepth d => CInt -> HIplImage MonoChromatic d -> 
-                  HIplImage TriChromatic d -> HIplImage TriChromatic d
+replaceChannel :: (HasDepth d, ImgBuilder r1, 
+                   InplaceROI r2 TriChromatic d TriChromatic d) => 
+                  CInt -> HIplImage MonoChromatic d r1 -> 
+                  HIplImage TriChromatic d r2 -> HIplImage TriChromatic d r2
 replaceChannel n c = cv2 $ \src dst -> 
                      withHIplImage c $ \cp ->
                        withArray [castPtr cp, src] $ \p1 -> 
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index ffda5a6..080ad4f 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 -- |Type-safe color conversion functions. 
 module AI.CV.OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
@@ -9,60 +10,57 @@ import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
 import AI.CV.OpenCV.Core.CVOp
 
-convertGrayToRGB :: HasDepth d =>
-                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
+type M = MonoChromatic
+type T = TriChromatic
+
+convertGrayToRGB :: (HasDepth d, InplaceROI r M d T d) =>
+                    HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
 convertGrayToRGB = convertColor cv_GRAY2RGB
 {-# INLINE convertGrayToRGB #-}
 
-convertGrayToBGR :: HasDepth d =>
-                    HIplImage MonoChromatic d -> HIplImage TriChromatic d
+convertGrayToBGR :: (HasDepth d, InplaceROI r M d T d) =>
+                    HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
 convertGrayToBGR = convertColor cv_GRAY2BGR
 {-# INLINE convertGrayToBGR #-}
 
-convertBGRToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
+convertBGRToGray :: (HasDepth d, InplaceROI r T d M d) =>
+                    HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
 convertBGRToGray = convertColor cv_BGR2GRAY
 {-# INLINE convertBGRToGray #-}
 
-convertRGBToGray :: HasDepth d =>
-                    HIplImage TriChromatic d -> HIplImage MonoChromatic d
+convertRGBToGray :: (HasDepth d, InplaceROI r T d M d) =>
+                    HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
 convertRGBToGray = convertBGRToGray
 {-# INLINE convertRGBToGray #-}
 
-convertBayerBgToBGR :: HasDepth d =>
-                       HIplImage MonoChromatic d -> HIplImage TriChromatic d
+convertBayerBgToBGR :: (HasDepth d, InplaceROI r M d T d) =>
+                       HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
 convertBayerBgToBGR = convertColor cv_BayerBG2BGR
 {-# INLINE convertBayerBgToBGR #-}
 
-convertBayerBgToRGB :: HasDepth d =>
-                       HIplImage MonoChromatic d -> HIplImage TriChromatic d
+convertBayerBgToRGB :: (HasDepth d, InplaceROI r M d T d) =>
+                       HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
 {-# INLINE convertBayerBgToRGB #-}
 
-convertRGBToHSV :: HasDepth d =>
-                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertRGBToHSV :: (HasDepth d, InplaceROI r T d T d) =>
+                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
 convertRGBToHSV = convertColor cv_RGB2HSV
 {-# INLINE convertRGBToHSV #-}
 
-convertBGRToHSV :: HasDepth d =>
-                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertBGRToHSV :: (HasDepth d, InplaceROI r T d T d) =>
+                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
 convertBGRToHSV = convertColor cv_BGR2HSV
 {-# INLINE convertBGRToHSV #-}
 
-convertHSVToBGR :: HasDepth d =>
-                   HIplImage TriChromatic d -> HIplImage TriChromatic d
+convertHSVToBGR :: (HasDepth d, InplaceROI r T d T d) =>
+                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
 convertHSVToBGR = convertColor cv_HSV2BGR
 {-# INLINE convertHSVToBGR #-}
 
 -- |Convert the color model of an image.
-convertColor :: (HasChannels c1, HasChannels c2, HasDepth d) =>
-                ColorConversion -> HIplImage c1 d -> HIplImage c2 d
+convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, 
+                 InplaceROI r c1 d c2 d) =>
+                ColorConversion -> HIplImage c1 d r -> HIplImage c2 d r
 convertColor cc = cv2 $ \src dst -> cvCvtColor src dst cc
--- convertColor cc img = unsafePerformIO . withHIplImage img $
---                         \src -> do dst <- mkHIplImage w h
---                                    withHIplImage dst $
---                                      \dst' -> cvCvtColor src dst' cc
---                                    return dst
---     where w = width img
---           h = height img
 {-# INLINE convertColor #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index e42eaeb..05fae2a 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 --
@@ -17,14 +17,16 @@
 -- with such an operation, must have a destination image
 -- allocated. This is cheaper than duplicating the input image as with
 -- operations wrapped by the `cv` combinator.
-module AI.CV.OpenCV.Core.CVOp (cv, cv2) where
+module AI.CV.OpenCV.Core.CVOp (cv, InplaceROI(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
 import AI.CV.OpenCV.Core.HIplUtil
+import AI.CV.OpenCV.Core.HIplImage
 import Control.Monad ((>=>), void)
 import Data.Monoid
-import Foreign.Ptr
 import Foreign.ForeignPtr
+import Foreign.Ptr
 import System.IO.Unsafe
+import Data.Word (Word8, Word16)
 
 -- |A CV operation is an IO function on a 'HIplImage'.
 newtype CVOp c d = CVOp { op :: Ptr CvArr -> IO () }
@@ -32,9 +34,9 @@ newtype CVOp c d = CVOp { op :: Ptr CvArr -> IO () }
 -- |A wrapper for operations that mutate an array in-place. The input
 -- to such operations must be duplicated before being passed to the
 -- operation.
-cv :: forall a c d e.
-      (HasChannels c, HasDepth d, IplArrayType e) => 
-      (Ptr e -> IO a) -> HIplImage c d -> HIplImage c d
+cv :: forall a c d e r1 r2.
+      (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, IplArrayType e) => 
+      (Ptr e -> IO a) -> HIplImage c d r1 -> HIplImage c d r2
 cv = runCV . mkCVOp
     where mkCVOp :: (Ptr e -> IO a) -> CVOp c d
           mkCVOp f = CVOp (void . f. castPtr)
@@ -45,31 +47,31 @@ instance Monoid (CVOp c d) where
   CVOp f `mappend` CVOp g = CVOp (\x -> g x >> f x)
   {-# INLINE mappend #-}
 
-withClone :: (HasChannels c, HasDepth d) =>
-             (Ptr e -> IO a) -> HIplImage c d -> IO (HIplImage c d)
+withClone :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2) =>
+             (Ptr e -> IO a) -> HIplImage c d r1 -> IO (HIplImage c d r2)
 withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f (castPtr x) >> 
                                                                fromPtr x)
 
 -- |Run a 'CVOp'.
-runCV :: (HasChannels c, HasDepth d) => 
-         CVOp c d -> HIplImage c d -> HIplImage c d
+runCV :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2) => 
+         CVOp c d -> HIplImage c d r1 -> HIplImage c d r2
 runCV = (unsafePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
 -- Apply a binary function to the same argument twice.
-dupArg :: (Ptr e -> Ptr e -> IO ()) -> Ptr e -> IO ()
+dupArg :: (Ptr e -> Ptr e -> IO a) -> Ptr e -> IO a
 dupArg f = \x -> f x x
 
 -- |Wrapper for operations that want an argument /and/ a compatible
 -- destination buffer, but don't need a clone of an input.
-cv2 :: forall a c1 d1 c2 d2 e.
-       (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-        IplArrayType e) => 
-       (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 -> HIplImage c2 d2
-cv2 = runBinOp . mkBinOp
+cv2Alloc :: forall a c1 d1 c2 d2 e r.
+            (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
+             IplArrayType e, ImgBuilder r) => 
+            (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
+cv2Alloc = runBinOp . mkBinOp
     where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp (c1,d1) (c2,d2)
           mkBinOp f = BinOp (\x y -> void (f (castPtr x) (castPtr y)))
-{-# INLINE cv2 #-}
+{-# INLINE cv2Alloc #-}
 
 bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
 bi2unary = CVOp . dupArg . binop
@@ -81,6 +83,63 @@ unary2bi = BinOp . const . op
 (<>) = mappend
 {-# INLINE (<>) #-}
 
+-- Some operations really benefit from operating in-place over a defined ROI.
+class (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) =>
+      InplaceROI r c1 d1 c2 d2 where
+  cv2 :: IplArrayType e =>
+           (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c, HasDepth d) => InplaceROI HasROI c d c d where
+  cv2 = cv . dupArg
+  {-# INLINE cv2 #-}
+
+instance (HasDepth d1, HasDepth d2) => 
+         InplaceROI HasROI TriChromatic d1 MonoChromatic d2 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasDepth d1, HasDepth d2) => 
+         InplaceROI HasROI MonoChromatic d1 TriChromatic d2 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Word8 c2 Float where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Word8 c2 Word16 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Word8 c2 Double where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Double c2 Word8 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Word16 c2 Word8 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasChannels c2) => 
+         InplaceROI HasROI c1 Float c2 Word8 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
+instance (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
+         InplaceROI NoROI c1 d1 c2 d2 where
+  cv2 = cv2Alloc
+  {-# INLINE cv2 #-}
+
 newtype BinOp a b = 
     BinOp { binop :: Ptr CvArr -> Ptr CvArr -> IO () }
 
@@ -89,16 +148,17 @@ cbop :: BinOp b b -> BinOp a b -> BinOp a b
 cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
 withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-            IplArrayType e) => 
+            ImgBuilder r, IplArrayType e) => 
            (Ptr e -> Ptr e -> IO a) ->
-           HIplImage c1 d1 -> IO (HIplImage c2 d2)
-withDst f img = do img2 <- mkHIplImage (width img) (height img)
+           HIplImage c1 d1 r -> IO (HIplImage c2 d2 r)
+withDst f img = do img2' <- mkHIplImage (width img) (height img)
+                   let img2 = addMaybeROI (roi img) img2'
                    _ <- withHIplImage img2 go
                    return img2
     where go x = withHIplImage img (flip f (castPtr x) . castPtr)
 
-runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) => 
-            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 -> HIplImage c2 d2
+runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) => 
+            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
 runBinOp = (unsafePerformIO .) . withDst . binop
 {-# NOINLINE runBinOp #-}
 
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index eb8a45e..cb393a2 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -53,7 +53,10 @@ instance VectorSpace CvSize where
   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 }
+data CvRect  = CvRect { rectX      :: {-# UNPACK #-} !CInt
+                      , rectY      :: {-# UNPACK #-} !CInt
+                      , rectWidth  :: {-# UNPACK #-} !CInt
+                      , rectHeight :: {-# UNPACK #-} !CInt }
                deriving (Show, Eq)
                         
 instance Storable CvRect where
@@ -201,11 +204,11 @@ createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z
 foreign import ccall "opencv2/core/core_c.h cvCloneImage"
   c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
 
-cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
-cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage
+cloneImage :: Ptr IplImage -> IO (Ptr IplImage)
+cloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage
                   
 cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage)
-cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x
+cloneImageF x = createForeignPtr cp_release_image $ cloneImage x
   
 foreign import ccall "HOpenCV_wrap.h get_size"
   c_get_size :: Ptr CvArr -> Ptr CvSize -> IO ()
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 0f0900d..d3ebc47 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,12 +1,16 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
              BangPatterns, FlexibleContexts #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
 module AI.CV.OpenCV.Core.HIplImage 
     ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
       HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
-      ByteOrFloat, HasScalar(..), IsCvScalar(..), freeROI) where
+      ByteOrFloat, HasScalar(..), IsCvScalar(..), freeROI, c_cvSetImageROI, 
+      c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
+      widthStep, imageDataOrigin, addROI, resetROI, ImgBuilder(..), 
+      HasROI, NoROI) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
-                                 iplDepth32f, iplDepth64f, cvFree)
+                                 iplDepth32f, iplDepth64f, cvFree, CvRect(..))
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
 import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
@@ -16,6 +20,7 @@ import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Array (allocaArray, peekArray)
 import Foreign.Ptr
 import Foreign.Storable
 import Unsafe.Coerce
@@ -136,29 +141,78 @@ bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
     where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
 
-
 -- |A data structure representing the information OpenCV uses from an
 -- 'IplImage' struct. It includes the pixel origin, image width, image
 -- height, image size (number of bytes), a pointer to the pixel data,
 -- and the row stride. Its type is parameterized by the number of
 -- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
 -- pixel depth (e.g. 'Word8', 'Float').
-data HIplImage c d = (HasChannels c, HasDepth d) => 
-                     HIplImage { origin          :: {-# UNPACK #-} !CInt
-                               , width           :: {-# UNPACK #-} !CInt
-                               , height          :: {-# UNPACK #-} !CInt
-                               , imageSize       :: {-# UNPACK #-} !CInt
-                               , imageData       :: {-# UNPACK #-} !(ForeignPtr d)
-                               , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
-                               , widthStep       :: {-# UNPACK #-} !CInt }
+-- data HIplImage c d = (HasChannels c, HasDepth d) => 
+--                      HIplImage { origin          :: {-# UNPACK #-} !CInt
+--                                , width           :: {-# UNPACK #-} !CInt
+--                                , height          :: {-# UNPACK #-} !CInt
+--                                , roi             :: !(Maybe CvRect)
+--                                , imageSize       :: {-# UNPACK #-} !CInt
+--                                , imageData       :: {-# UNPACK #-} !(ForeignPtr d)
+--                                , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
+--                                , widthStep       :: {-# UNPACK #-} !CInt }
+
+data HasROI
+data NoROI
+
+data HIplImage c d r where
+  Img :: (HasChannels c, HasDepth d) => 
+         !CInt -> !CInt -> !CInt -> !CInt -> !(ForeignPtr d) -> !(ForeignPtr d) -> 
+         !CInt -> HIplImage c d NoROI
+  ImgR :: (HasChannels c, HasDepth d) => 
+          !CInt -> !CInt -> !CInt -> !CvRect -> !CInt -> !(ForeignPtr d) -> 
+          !(ForeignPtr d) -> !CInt -> HIplImage c d HasROI
+
+origin :: HIplImage c d r -> CInt
+origin (Img o _ _ _ _ _ _) = o
+origin (ImgR o _ _ _ _ _ _ _) = o
+
+imageSize :: HIplImage c d r -> CInt
+imageSize (Img _ _ _ s _ _ _) = s
+imageSize (ImgR _ _ _ _ s _ _ _) = s
+
+roi :: HIplImage c d r -> Maybe CvRect
+roi (ImgR _ _ _ r _ _ _ _) = Just r
+roi _ = Nothing
+
+imageData :: HIplImage c d r -> ForeignPtr d
+imageData (Img _ _ _ _ p _ _) = p
+imageData (ImgR _ _ _ _ _ p _ _) = p
+
+imageDataOrigin :: HIplImage c d r -> ForeignPtr d
+imageDataOrigin (Img _ _ _ _ _ p _) = p
+imageDataOrigin (ImgR _ _ _ _ _ _ p _) = p
+
+width,height,widthStep :: HIplImage c d r -> CInt
+width (Img _ w _ _ _ _ _) = w
+width (ImgR _ w _ _ _ _ _ _) = w
+height (Img _ _ h _ _ _ _) = h
+height (ImgR _ _ h _ _ _ _ _) = h
+widthStep (Img _ _ _ _ _ _ ws) = ws
+widthStep (ImgR _ _ _ _ _ _ _ ws) = ws
+
+addROI :: CvRect -> HIplImage c d r -> HIplImage c d HasROI
+addROI r (Img o w h sz d ido ws) = ImgR o w h r sz d ido ws
+addROI r (ImgR o w h _ sz d ido ws) = ImgR o w h r sz d ido ws
+{-# INLINE addROI #-}
+
+resetROI :: HIplImage c d r -> HIplImage c d NoROI
+resetROI x@(Img _ _ _ _ _ _ _) = x
+resetROI (ImgR o w h _ sz d ido ws) = Img o w h sz d ido ws
+{-# INLINE resetROI #-}
 
 -- |Prepare a 'HIplImage' of the given width and height. The pixel and
 -- color depths are gleaned from the type, and may often be inferred.
 mkHIplImage :: forall a c d. (HasChannels c, HasDepth d, Integral a) => 
-               a -> a -> IO (HIplImage c d)
+               a -> a -> IO (HIplImage c d NoROI)
 mkHIplImage w' h' = 
     do ptr <- mallocForeignPtrArray (fromIntegral numBytes)
-       return $ HIplImage 0 w h numBytes ptr ptr stride
+       return $ Img 0 w h numBytes ptr ptr stride
     where w = fromIntegral w'
           h = fromIntegral h'
           numBytes = stride * h
@@ -172,7 +226,7 @@ foreign import ccall "memset"
 -- |Prepare a 'HIplImage' of the given width and height. Set all
 -- pixels to zero.
 mkBlackImage :: (HasChannels c, HasDepth d, Integral a) => 
-                a -> a -> IO (HIplImage c d)
+                a -> a -> IO (HIplImage c d NoROI)
 mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
                       let sz = fromIntegral $ imageSize img
                       withForeignPtr (imageData img) $ \ptr ->
@@ -182,17 +236,35 @@ mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying the given 'HIplImage'.
 withHIplImage :: (HasChannels c, HasDepth d) =>
-                 HIplImage c d -> (Ptr IplImage -> IO b) -> IO b
+                 HIplImage c d r -> (Ptr IplImage -> IO b) -> IO b
 withHIplImage img f = alloca $ 
                       \p -> withForeignPtr (imageData img) 
                                            (\hp -> pokeIpl img p (castPtr hp) >>
-                                                   f p)
+                                                   withROI img p f)
+
+withROI :: (HasChannels c, HasDepth d) => 
+           HIplImage c d r -> Ptr IplImage -> (Ptr IplImage -> IO a) -> IO a
+withROI img p f = case roi img of
+                    Nothing -> f p
+                    Just (CvRect x y w h) -> do c_cvSetImageROI p x y w h
+                                                r <- f p
+                                                c_cvResetImageROI p
+                                                return r
+
+foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
+  c_cvSetImageROI :: Ptr IplImage -> CInt -> CInt -> CInt -> CInt -> IO ()
+
+foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
+  c_cvResetImageROI :: Ptr IplImage -> IO ()
+
+foreign import ccall "HOpenCV_wrap.h c_cvGetROI"
+  c_cvGetImageROI :: Ptr IplImage -> Ptr CInt -> IO ()
 
 -- Poke a 'Ptr' 'IplImage' with a specific imageData 'Ptr' that is
 -- currently valid. This is solely an auxiliary function to
 -- 'withHIplImage'.
-pokeIpl :: forall c d. (HasChannels c, HasDepth d) => 
-           HIplImage c d -> Ptr IplImage -> Ptr Word8 -> IO ()
+pokeIpl :: forall c d r. (HasChannels c, HasDepth d) => 
+           HIplImage c d r -> Ptr IplImage -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
     do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
        (#poke IplImage, ID) ptr (0::Int)
@@ -216,6 +288,31 @@ freeROI :: Ptr IplImage -> IO ()
 freeROI ptr = do p <- (#peek IplImage, roi) ptr
                  if (ptrToIntPtr p == 0) then return () else cvFree p
 
+maybePeek :: Ptr IplImage -> Ptr () -> IO (Maybe CvRect)
+maybePeek img p | p == nullPtr = return Nothing
+                | otherwise = allocaArray 4 $ 
+                              \r -> do c_cvGetImageROI img r
+                                       [x,y,w,h] <- peekArray 4 r
+                                       return . Just $ CvRect x y w h
+
+class ImgBuilder a where
+  buildImg :: (HasChannels c, HasDepth d) =>
+              CInt -> CInt -> CInt -> Maybe CvRect -> CInt ->
+              ForeignPtr d -> ForeignPtr d -> CInt -> HIplImage c d a
+  addMaybeROI :: Maybe CvRect -> (HIplImage c d r) -> HIplImage c d a
+
+instance ImgBuilder NoROI where
+  buildImg o w h Nothing sz d ido ws = Img o w h sz d ido ws
+  buildImg _ _ _ _ _ _ _ _ = error "Building a NoROI image, but was given a ROI!"
+  addMaybeROI Nothing x = resetROI x
+  addMaybeROI _ _ = error "addMaybeROI tried to add a ROI to a NoROI Image!"
+
+instance ImgBuilder HasROI where
+  buildImg o w h (Just r) sz d ido ws = ImgR o w h r sz d ido ws
+  buildImg _ _ _ _ _ _ _ _ = error "Building a ROI image, but wasn't given a ROI!"
+  addMaybeROI (Just r) x = addROI r x
+  addMaybeROI _ _ = error "addMaybeROI tried to add a null ROI to a HasROI Image!"
+
 -- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
 -- structure type. They share the same binary representation through
 -- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
@@ -226,8 +323,8 @@ freeROI ptr = do p <- (#peek IplImage, roi) ptr
 -- values constructed within the Haskell runtime, on the other hand,
 -- do have their underlying pixel data buffers registered with a
 -- finalizer.
-instance forall c d. (HasChannels c, HasDepth d) => 
-    Storable (HIplImage c d) where
+instance forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
+    Storable (HIplImage c d r) where
     sizeOf _ = (#size IplImage)
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a Ptr HIplImage is unsafe."
@@ -236,12 +333,14 @@ instance forall c d. (HasChannels c, HasDepth d) =>
       depth' <- Depth <$> (#peek IplImage, depth) ptr
       width' <- (#peek IplImage, width) ptr
       height' <- (#peek IplImage, height) ptr
+      roir <- (#peek IplImage, roi) ptr >>= maybePeek (castPtr ptr)
       when (depth' /= (depth (undefined::d)))
            (error $ "IplImage has depth "++show depth'++
                     " but desired HIplImage has depth "++
                     show (depth (undefined::d)))
       if numChannels (undefined::c) /= numChannels'
-        then do img2 <- mkHIplImage width' height' :: IO (HIplImage c d)
+        then do img2' <- mkHIplImage width' height' :: IO (HIplImage c d NoROI)
+                let img2 = addMaybeROI roir img2' :: HIplImage c d r
                 let conv = if numChannels' == 1 
                            then cv_GRAY2BGR
                            else cv_BGR2GRAY
@@ -256,5 +355,10 @@ instance forall c d. (HasChannels c, HasDepth d) =>
                 imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
                 imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
                 widthStep' <- (#peek IplImage, widthStep) ptr
-                return $ HIplImage origin' width' height' imageSize' 
-                                   imageData' imageDataOrigin' widthStep'
+                return $ buildImg origin' width' height' roir imageSize'
+                                  imageData' imageDataOrigin' widthStep'
+                -- return $ case roir of
+                --            Nothing -> Img origin' width' height' imageSize' 
+                --                           imageData' imageDataOrigin' widthStep'
+                --            Just r -> ImgR origin' width' height' r imageSize' 
+                --                           imageData' imageDataOrigin' widthStep'
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index 91e8a2c..cfa6d06 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -6,10 +6,10 @@ module AI.CV.OpenCV.Core.HIplUtil
      fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
-     withDuplicateImage, withCompatibleImage, pipeline,
-     HIplImage, mkHIplImage, width, height, mkBlackImage,
-     withHIplImage, MonoChromatic, TriChromatic, HasChannels, 
-     GrayImage, GrayImage16, ColorImage,
+     withDuplicateImage, withCompatibleImage, 
+     mkHIplImage, width, height, mkBlackImage, HIplImage, NoROI, HasROI,
+     withHIplImage, MonoChromatic, TriChromatic, HasChannels, ImgBuilder(..),
+     GrayImage, GrayImage16, ColorImage, c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
@@ -20,7 +20,7 @@ import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import AI.CV.OpenCV.Core.HIplImage
 import Control.Applicative
 import Control.Arrow (second, (***))
-import Control.Monad ((<=<), when, unless, join)
+import Control.Monad (when, unless, join)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -33,24 +33,24 @@ import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode,
 import System.IO.Unsafe
 
 -- |Grayscale 8-bit (per-pixel) image type.
-type GrayImage = HIplImage MonoChromatic Word8
+type GrayImage = HIplImage MonoChromatic Word8 NoROI
 
 -- |Grayscale 16-bit (per-pixel) image type.
-type GrayImage16 = HIplImage MonoChromatic Word16
+type GrayImage16 = HIplImage MonoChromatic Word16 NoROI
 
 -- |Color 8-bit (per-color) image type.
-type ColorImage = HIplImage TriChromatic Word8
+type ColorImage = HIplImage TriChromatic Word8 NoROI
 
 -- |This is a way to let the type checker know that you belieave an
 -- image to be tri-chromatic. If your image type can't be inferred any
 -- other way, this is an alternative to adding a type annotation.
-isColor :: HIplImage TriChromatic d -> HIplImage TriChromatic d
+isColor :: HIplImage TriChromatic d r -> HIplImage TriChromatic d r
 isColor = id
 
 -- |This is a way to let the type checker know that you believe an
 -- image to be monochromatic. If your image type can't be inferred any
 -- other way, this is an alternative to adding a type annotation.
-isMono :: HIplImage MonoChromatic d -> HIplImage MonoChromatic d
+isMono :: HIplImage MonoChromatic d r -> HIplImage MonoChromatic d r
 isMono = id
 
 {-# INLINE isMono #-}
@@ -58,24 +58,24 @@ isMono = id
 
 -- |Return the number of color channels a 'HIplImage' has as a runtime
 -- value.
-imgChannels :: forall c d. HasChannels c => HIplImage c d -> Int
+imgChannels :: forall c d r. HasChannels c => HIplImage c d r -> Int
 imgChannels _ = fromIntegral $ numChannels (undefined::c)
 
 -- |Return the number of bytes per pixel color component of an
 -- 'HIplImage'.
-colorDepth :: forall c d. HasDepth d => HIplImage c d -> Int
+colorDepth :: forall c d r. HasDepth d => HIplImage c d r -> Int
 colorDepth _ = bytesPerPixel (undefined::d)
 
 -- |Apply the supplied function to a 'V.Vector' containing the pixels
 -- that make up an 'HIplImage'. This does not copy the underlying
 -- data.
-withImagePixels :: HasDepth d => HIplImage c d -> (V.Vector d -> r) -> r
+withImagePixels :: HasDepth d => HIplImage c d NoROI -> (V.Vector d -> r) -> r
 withImagePixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
     where n = fromIntegral (imageSize img) `div` colorDepth img
 
 -- |Return a 'V.Vector' containing a copy of the pixels that make up a
 -- 'HIplImage'.
-pixels :: Storable d => HIplImage c d -> V.Vector d
+pixels :: Storable d => HIplImage c d NoROI -> V.Vector d
 pixels img = unsafePerformIO $ 
              do ptr <- mallocForeignPtrBytes len
                 withForeignPtr ptr $ \dst -> 
@@ -86,7 +86,8 @@ pixels img = unsafePerformIO $
 {-# NOINLINE pixels #-}
 
 -- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: (HasChannels c, HasDepth d) => Ptr IplImage -> IO (HIplImage c d)
+fromPtr :: (HasChannels c, HasDepth d, ImgBuilder r) => 
+           Ptr IplImage -> IO (HIplImage c d r)
 fromPtr = peek . castPtr
 
 -- Ensure that a file exists.
@@ -96,11 +97,11 @@ checkFile f = do e <- doesFileExist f
 
 -- |Load a color 'HIplImage' from an 8-bit image file. If the image
 -- file is grayscale, it will be converted to color.
-fromFileColor :: FilePath -> IO (HIplImage TriChromatic Word8)
+fromFileColor :: FilePath -> IO (HIplImage TriChromatic Word8 NoROI)
 fromFileColor fileName = 
   do checkFile fileName
      ptr <- cvLoadImage fileName LoadColor
-     img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8)
+     img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8 NoROI)
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      freeROI ptr
      cvFree ptr
@@ -108,16 +109,16 @@ fromFileColor fileName =
 
 -- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
 -- image file is color, it will be converted to grayscale.
-fromFileGray :: FilePath -> IO (HIplImage MonoChromatic Word8)
+fromFileGray :: FilePath -> IO (HIplImage MonoChromatic Word8 NoROI)
 fromFileGray fileName = 
   do checkFile fileName
      ptr <- cvLoadImage fileName LoadGray
-     img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8)
+     img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8 NoROI)
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      return img
 
 class LoadableFormat c d where
-  loadFormat :: (c,d) -> FilePath -> IO (HIplImage c d)
+  loadFormat :: (c,d) -> FilePath -> IO (HIplImage c d NoROI)
 
 instance LoadableFormat MonoChromatic Word8 where
   loadFormat _ = fromFileGray
@@ -131,7 +132,7 @@ instance LoadableFormat MonoChromatic Word16 where
 -- |An overloaded image file loader. The number of color channels and
 -- color depth parts of the returned image's type must be inferrable
 -- as they control how the image file is loaded.
-fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (HIplImage c d)
+fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (HIplImage c d NoROI)
 fromFile = loadFormat (undefined :: (c,d))
 
 -- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
@@ -139,7 +140,7 @@ fromFile = loadFormat (undefined :: (c,d))
 -- so this 16bpp loader is restricted to PGM. This loading routine
 -- converts from Most Significant Byte first (MSB) byte ordering (as
 -- per the PGM spec) to LSB byte ordering for x86 compatibility.
-fromPGM16 :: FilePath -> IO (HIplImage MonoChromatic Word16)
+fromPGM16 :: FilePath -> IO (HIplImage MonoChromatic Word16 NoROI)
 fromPGM16 fileName = 
   do checkFile fileName
      h <- openFile fileName ReadMode
@@ -168,25 +169,27 @@ fromPGM16 fileName =
                                  swapBytes (offset+2)
           swapBytes 0
      hClose h
-     return $ HIplImage 0 width height (fromIntegral numBytes) fp fp (2*width)
+     return $ Img 0 width height (fromIntegral numBytes) fp fp (2*width)
 
 -- |Save an image to the specified file.
-toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d -> IO ()
+toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d r -> IO ()
 toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
 
 -- |Allocate a new 'HIplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing HIplImage. The pixel
 -- data of the original 'HIplImage' is not copied.
-compatibleImage :: HIplImage c d -> IO (HIplImage c d)
-compatibleImage (HIplImage _ w h sz _ _ stride) = 
-    do ptr <- mallocForeignPtrArray (fromIntegral sz)
-       return $ HIplImage 0 w h sz ptr ptr stride
+compatibleImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
+                   HIplImage c d r -> IO (HIplImage c d r)
+compatibleImage img = 
+    do ptr <- mallocForeignPtrArray (fromIntegral (imageSize img))
+       return $ buildImg 0 (width img) (height img) (roi img) 
+                         (imageSize img) ptr ptr (widthStep img)
 
 -- |Allocate a new 'IplImage' with the same dimensions, number of
 -- color channels, and color depth as an existing 'HIplImage'. The
 -- pixel data of the original 'HIplImage' is not copied.
-compatibleImagePtr :: forall c d. (HasChannels c, HasDepth d) =>
-                      HIplImage c d -> IO (ForeignPtr IplImage)
+compatibleImagePtr :: forall c d r. (HasChannels c, HasDepth d) =>
+                      HIplImage c d r -> IO (ForeignPtr IplImage)
 compatibleImagePtr img = createImageF (CvSize w' h') nc d
     where w' = fromIntegral . width $ img
           h' = fromIntegral . height $ img
@@ -199,18 +202,21 @@ compatibleImagePtrPtr =
 
 -- |Create an exact duplicate of the given HIplImage. This allocates a
 -- fresh array to store the copied pixels.
-duplicateImage :: HIplImage c d -> IO (HIplImage c d)
-duplicateImage (HIplImage _ w h sz pixels _ stride) =
+duplicateImage :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+                  HIplImage c d r -> IO (HIplImage c d r)
+--duplicateImage (HIplImage _ w h r sz pixels _ stride) =
+duplicateImage img =
     do fptr <- mallocForeignPtrArray sz'
-       withForeignPtr pixels $ 
+       withForeignPtr (imageData img) $ 
            \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz'
-       return $ HIplImage 0 w h sz fptr fptr stride
-  where sz' = fromIntegral sz
+       return $ buildImg 0 (width img) (height img) (roi img) 
+                         (imageSize img) fptr fptr (widthStep img)
+  where sz' = fromIntegral (imageSize img)
 
 -- |Clone an 'HIplImage', returning the 'Ptr' 'IplImage' underlying
 -- the clone.
 duplicateImagePtr :: (HasChannels c, HasDepth d) =>
-                     HIplImage c d -> IO (ForeignPtr IplImage)
+                     HIplImage c d r -> IO (ForeignPtr IplImage)
 duplicateImagePtr = flip withHIplImage cloneImageF
 
 -- |Pass the given function a 'HIplImage' constructed from a width, a
@@ -218,9 +224,9 @@ duplicateImagePtr = flip withHIplImage cloneImageF
 -- pixel data is shared with the supplied 'V.Vector'.
 withPixelVector :: forall a c d r. 
                    (HasChannels c, Integral a, HasDepth d) =>
-                   a -> a -> V.Vector d -> (HIplImage c d -> r) -> r
+                   a -> a -> V.Vector d -> (HIplImage c d NoROI -> r) -> r
 withPixelVector w h pix f = if fromIntegral len == sz
-                            then f $ HIplImage 0 w' h' sz fp fp (w'*nc)
+                            then f $ Img 0 w' h' sz fp fp (w'*nc)
                             else error "Length disagreement"
     where w' = fromIntegral w
           h' = fromIntegral h
@@ -234,10 +240,10 @@ withPixelVector w h pix f = if fromIntegral len == sz
 -- 'V.Vector' of pixel values.
 fromPixels :: forall a c d. 
               (Integral a, HasChannels c, HasDepth d) =>
-              a -> a -> V.Vector d -> HIplImage c d
+              a -> a -> V.Vector d -> HIplImage c d NoROI
 fromPixels w h pix = unsafePerformIO $ 
                      do fp <- copyData
-                        return $ HIplImage 0 w' h' sz fp fp (w'*nc)
+                        return $ Img 0 w' h' sz fp fp (w'*nc)
     where w' = fromIntegral w
           h' = fromIntegral h
           nc = numChannels (undefined::c)
@@ -255,23 +261,23 @@ fromPixels w h pix = unsafePerformIO $
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
 fromGrayPixels :: (HasDepth d, Integral a) => 
-                  a -> a -> V.Vector d -> HIplImage MonoChromatic d
+                  a -> a -> V.Vector d -> HIplImage MonoChromatic d NoROI
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of interleaved
 -- trichromatic pixel data. Parameters are the output image's width,
 -- height, and pixel content.
 fromColorPixels :: (HasDepth d, Integral a) =>
-                   a -> a -> V.Vector d -> HIplImage TriChromatic d
+                   a -> a -> V.Vector d -> HIplImage TriChromatic d NoROI
 fromColorPixels w h = isColor . fromPixels w h
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' that is an exact duplicate of the
 -- given 'HIplImage'. Returns the duplicate 'HIplImage' after
 -- performing the given action along with the result of that action.
-withDuplicateImage :: (HasChannels c, HasDepth d) => 
-                      HIplImage c d -> (Ptr IplImage -> IO b) -> 
-                      IO (HIplImage c d, b)
+withDuplicateImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
+                      HIplImage c d r -> (Ptr IplImage -> IO b) -> 
+                      IO (HIplImage c d r, b)
 withDuplicateImage img1 f = do img2 <- duplicateImage img1
                                r <- withHIplImage img2 f
                                return (img2, r)
@@ -279,15 +285,15 @@ withDuplicateImage img1 f = do img2 <- duplicateImage img1
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
 -- underlying a new 'HIplImage' of the same dimensions as the given
 -- 'HIplImage'.
-withCompatibleImage :: (HasChannels c, HasDepth d) => 
-                       HIplImage c d -> (Ptr IplImage -> IO b) -> 
-                       IO (HIplImage c d, b)
+withCompatibleImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
+                       HIplImage c d r -> (Ptr IplImage -> IO b) -> 
+                       IO (HIplImage c d r, b)
 withCompatibleImage img1 f = do img2 <- compatibleImage img1
                                 r <- withHIplImage img2 f
                                 return (img2, r)
 
 unsafeWithHIplImage :: (HasChannels c, HasDepth d) =>
-                       HIplImage c d -> (Ptr IplImage -> a) -> a
+                       HIplImage c d r -> (Ptr IplImage -> a) -> a
 unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
 
 -- |Extract a rectangular region of interest from an image. Returns a
@@ -296,7 +302,7 @@ unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
 -- rectangle in image coordinates, the (width,height) of the rectangle
 -- in pixels, and the source 'HIplImage'.
 getRect :: (HasChannels c, HasDepth d) =>
-           (Int,Int) -> (Int,Int) -> HIplImage c d -> IO (HIplImage c d)
+           (Int,Int) -> (Int,Int) -> HIplImage c d r -> IO (HIplImage c d NoROI)
 getRect (rx,ry) (rw,rh) src = 
     do img <- mkHIplImage (fromIntegral rw) (fromIntegral rh)
        withForeignPtr (imageData img) $ \dst ->
@@ -310,14 +316,3 @@ getRect (rx,ry) (rw,rh) src =
           start = stride*ry + rx*bpp
           bpp = imgChannels src * colorDepth src
           rowLen = rw*bpp
-
-pipeline :: (HIplImage c d -> IO r) -> HIplImage c d -> r
-pipeline f = unsafePerformIO . (f <=< duplicateImage)
-{-# INLINE [0] pipeline #-}
-
-{-# RULES
-"pipeline/join" forall f g h.
-  pipeline f (pipeline g h) = pipeline (f <=< g) h
-"pipeline/compose" forall f g.
-  pipeline f . pipeline g = pipeline (f <=< g)
-  #-}
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index f2be1dd..0f24e35 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -181,6 +181,15 @@ void c_cvSetRoi(IplImage* img, int x, int y, int width, int height)
   cvSetImageROI(img, cvRect(x,y,width,height));
 }
 
+void c_cvGetROI(IplImage* img, int* rptr)
+{
+    CvRect r = cvGetImageROI(img);
+    rptr[0] = r.x; 
+    rptr[1] = r.y;
+    rptr[2] = r.width;
+    rptr[3] = r.height;
+}
+
 void c_cvAvg(const CvArr *img, const CvArr *mask, double* avg)
 {
   CvScalar s = cvAvg(img, mask);
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 6d4d698..870fb87 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -37,6 +37,7 @@ void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g,
               double b, int thickness, int lineType, int shift);
 
 void c_cvSetRoi(IplImage* img, int x, int y, int width, int height);
+void c_cvGetROI(IplImage* img, int* rptr);
 
 void c_cvPutText(CvArr *img, const char* msg, int x, int y, 
                  double r, double g, double b);
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
index 871c30f..6577fcd 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -41,10 +41,10 @@ defaultFont = unsafePerformIO $ initFont NormalSans False 1 1 0 1 EightConn
 -- a text-drawing function using a font with the given @face@ (which
 -- may be @italic@), horizontal and verticale scale, and line
 -- @thickness@.
-prepFont :: (HasChannels c, HasDepth d) =>
+prepFont :: (HasChannels c, HasDepth d, ImgBuilder r) =>
             FontFace -> Bool -> CDouble -> CDouble -> CInt -> 
             IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-                HIplImage c d -> HIplImage c d)
+                HIplImage c d r -> HIplImage c d r)
 prepFont face italic hscale vscale thickness = 
     prepFontAlt face italic hscale vscale 0 thickness EightConn
 {-# INLINE prepFont #-}
@@ -54,11 +54,11 @@ prepFont face italic hscale vscale thickness =
 -- ltype@ produces a text-drawing function using a font with the given
 -- @face@ (which may be @italic@), horizontal and vertical scale,
 -- @shear@, line @thickness@, and line type.
-prepFontAlt :: (HasChannels c, HasDepth d) =>
+prepFontAlt :: (HasChannels c, HasDepth d, ImgBuilder r) =>
                FontFace -> Bool -> CDouble -> CDouble -> CDouble -> 
                CInt -> LineType ->
                IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-                   HIplImage c d -> HIplImage c d)
+                   HIplImage c d r -> HIplImage c d r)
 prepFontAlt face italic hscale vscale shear thickness ltype =     
     do f <- initFont face italic hscale vscale shear thickness ltype
        let go (x,y) (r,g,b) msg = cv $ \dst -> 
@@ -68,9 +68,9 @@ prepFontAlt face italic hscale vscale shear thickness ltype =
        return go
 {-# INLINE prepFontAlt #-}
 
-putText :: (HasChannels c, HasDepth d) => 
+putText :: (HasChannels c, HasDepth d, ImgBuilder r) => 
            (CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-           HIplImage c d -> HIplImage c d
+           HIplImage c d r -> HIplImage c d r
 putText (x,y) (r,g,b) msg = cv $ \dst ->
                             withCString msg $ \msg' ->
                                 cvPutText dst msg' x y defaultFont r g b
@@ -97,9 +97,9 @@ lineTypeEnum AALine    = 16
 -- |Draw each line, defined by its endpoints, on a duplicate of the
 -- given 'HIplImage' using the specified RGB color, line thickness,
 -- and aliasing style.
-drawLines :: (HasChannels c, HasDepth d) =>
+drawLines :: (HasChannels c, HasDepth d, ImgBuilder r) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-             HIplImage c d -> HIplImage c d
+             HIplImage c d r -> HIplImage c d r
 drawLines col thick lineType lines = 
     cv $ \img -> mapM_ (draw img) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 23b6906..9a1f700 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, FlexibleContexts #-}
 -- |Feature Detection.
 module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
 import Foreign.C.Types (CInt, CDouble)
@@ -16,11 +16,13 @@ harris src dst blockSize aperture k =
     where fi = fromIntegral
           rf = realToFrac
 
+type M = MonoChromatic
+
 -- |Equivalent to 'cornerHarris'' with an @aperture@ of @3@ and a @k@
 -- of @0.04@.
-cornerHarris :: ByteOrFloat d => 
-                Int -> HIplImage MonoChromatic d -> 
-                HIplImage MonoChromatic Float
+cornerHarris :: (ByteOrFloat d, InplaceROI r M d M Float) => 
+                Int -> HIplImage MonoChromatic d r -> 
+                HIplImage MonoChromatic Float r
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 {-# INLINE cornerHarris #-}
 
@@ -32,9 +34,9 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 -- @aperture@ size to be used by the Sobel operator that is run during
 -- corner evaluation, the value of @k@, and the source
 -- 'HIplImage'.
-cornerHarris' :: ByteOrFloat d => 
-                 Int -> Int -> Double -> HIplImage MonoChromatic d -> 
-                 HIplImage MonoChromatic Float
+cornerHarris' :: (ByteOrFloat d, InplaceROI r M d M Float) => 
+                 Int -> Int -> Double -> HIplImage MonoChromatic d r -> 
+                 HIplImage MonoChromatic Float r
 cornerHarris' blockSize aperture k = 
     cv2 $ \src dst -> harris src dst blockSize aperture k
 {-# INLINE cornerHarris' #-}
@@ -47,9 +49,9 @@ foreign import ccall "opencv2/imgprog/imgproc_c.h cvCanny"
 -- thresholds used to find initial segments of strong edges while the
 -- smaller threshold is used for edge linking. The third parameter is
 -- the aperture size used for initial Sobel operator edge detection.
-canny :: HasDepth d =>
-         Double -> Double -> Int -> HIplImage MonoChromatic d -> 
-         HIplImage MonoChromatic d
+canny :: (HasDepth d, InplaceROI r M d M d) =>
+         Double -> Double -> Int -> HIplImage MonoChromatic d r -> 
+         HIplImage MonoChromatic d r
 canny t1 t2 aperture = 
     cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
     --cv $ \src -> c_cvCanny src src (rf t1) (rf t2) (fi aperture)
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 36f11ae..a4801c8 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -31,8 +31,8 @@ cvGaussian = #{const CV_GAUSSIAN}
 -- the kernel size. This function is the same as calling
 -- @smoothGaussian' width Nothing Nothing@. May be performed in-place
 -- under composition.
-smoothGaussian :: (ByteOrFloat d, HasChannels c) => 
-                  Int -> HIplImage c d -> HIplImage c d
+smoothGaussian :: (ByteOrFloat d, HasChannels c, InplaceROI r c d c d) => 
+                  Int -> HIplImage c d r -> HIplImage c d r
 smoothGaussian w = smoothGaussian' w Nothing Nothing
 {-# INLINE smoothGaussian #-}
 
@@ -42,9 +42,9 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
 -- calculated from the kernel size), and the source image. May be
 -- performed in-place under composition.
-smoothGaussian' :: (ByteOrFloat d, HasChannels c) => 
-                   Int -> Maybe Int -> Maybe Double -> HIplImage c d -> 
-                   HIplImage c d
+smoothGaussian' :: (ByteOrFloat d, HasChannels c, InplaceROI r c d c d) => 
+                   Int -> Maybe Int -> Maybe Double -> HIplImage c d r -> 
+                   HIplImage c d r
 smoothGaussian' w h sigma = 
     cv2 $ \src dst -> smooth src dst cvGaussian w h' sigma' 0
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 47d3215..9f94d75 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -55,9 +55,9 @@ floodHelper (x,y) newVal loDiff upDiff range src =
 -- painting should be compared to the seed pixel ('FloodFixed') or to
 -- their neighbors ('FloodFloating'); the source image.
 floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
-              IsCvScalar s, s ~ CvScalar c d) => 
-             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d -> 
-             HIplImage c d
+              IsCvScalar s, s ~ CvScalar c d, ImgBuilder r) => 
+             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d r -> 
+             HIplImage c d r
 floodFill seed newVal loDiff upDiff range = 
     cv $ floodHelper seed (toCvScalar newVal) (toCvScalar loDiff)
                      (toCvScalar upDiff) range
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/AI/CV/OpenCV/GUI.hs
index 5ebe467..03a9271 100644
--- a/src/AI/CV/OpenCV/GUI.hs
+++ b/src/AI/CV/OpenCV/GUI.hs
@@ -17,14 +17,15 @@ bool _ f False = f
 
 -- |Simple window runner. Takes an action that produces images to be
 -- shown in the window. Exits when any key is pressed.
-runWindow :: HasChannels c => IO (HIplImage c Word8) -> IO ()
+runWindow :: (HasChannels c, ImgBuilder r) => IO (HIplImage c Word8 r) -> IO ()
 runWindow mkImg = newWindow 0 True >> go
     where go = do mkImg >>= flip withHIplImage (showImage 0)
                   cvWaitKey 1 >>= bool (delWindow 0) go . (> 0)
 
 -- |Simple named window runner. Exits when any key is pressed. The
 -- name is shown in the window's title bar.
-runNamedWindow :: HasChannels c => String -> IO (HIplImage c Word8) -> IO ()
+runNamedWindow :: (HasChannels c, ImgBuilder r) => 
+                  String -> IO (HIplImage c Word8 r) -> IO ()
 runNamedWindow name mkImg = 
     do name' <- newCString name
        cvNamedWindow name' (windowFlagsToEnum [AutoSize])
@@ -37,10 +38,10 @@ runNamedWindow name mkImg =
 -- action for showing an image, and an action for destroying the
 -- window. Be sure to repeatedly invoke 'waitKey' to keep the system
 -- alive.
-namedWindow :: (HasChannels c, HasDepth d) => 
+namedWindow :: (HasChannels c, HasDepth d, ImgBuilder r) => 
                String -> [WindowFlag] -> 
                --Maybe MouseCallback -> 
-               IO (HIplImage c d -> IO (), IO ())
+               IO (HIplImage c d r -> IO (), IO ())
 namedWindow name flags =
   do cstr <- newCString name
      let showImg img = withHIplImage img $ \imgPtr ->
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index ffa706e..d38f80a 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -22,7 +22,7 @@ module AI.CV.OpenCV.HighCV (
                             module AI.CV.OpenCV.FloodFill,
                             module AI.CV.OpenCV.FeatureDetection,
                             Connectivity(..), 
-                            CvRect(..),
+                            CvRect(..), liftCvRect,
                             cv_L2, cv_MinMax, 
                             InterpolationMethod(..), 
                             -- * GUI and Drawing
@@ -55,15 +55,15 @@ import AI.CV.OpenCV.Video
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: (HasChannels c, HasDepth d) =>
-         Int -> HIplImage c d -> HIplImage c d
+erode :: (HasChannels c, HasDepth d, InplaceROI r c d c d) =>
+         Int -> HIplImage c d r -> HIplImage c d r
 erode n = cv2 $ \src dst -> cvErode src dst (fromIntegral n)
 {-# INLINE erode #-}
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: (HasChannels c, HasDepth d) =>
-          Int -> HIplImage c d -> HIplImage c d
+dilate :: (HasChannels c, HasDepth d, InplaceROI r c d c d) =>
+          Int -> HIplImage c d r -> HIplImage c d r
 dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
 {-# INLINE dilate #-}
 
@@ -71,8 +71,8 @@ dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
 -- the end points. Parameters are the two endpoints, the line
 -- connectivity to use when sampling, and an image; returns the list
 -- of pixel values.
-sampleLine :: (HasChannels c, HasDepth d) =>
-              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage c d -> [d]
+sampleLine :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage c d r -> [d]
 sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $ 
                                 \p -> cvSampleLine p pt1 pt2 conn
 {-# NOINLINE sampleLine #-}
@@ -81,7 +81,8 @@ sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $
 -- transform. Parameters are @rho@, the distance resolution in
 -- pixels; @theta@, the angle resolution in radians; @threshold@, the
 -- line classification accumulator threshold; and the input image.
-houghStandard :: Double -> Double -> Int -> HIplImage MonoChromatic Word8 -> 
+houghStandard :: ImgBuilder r =>
+                 Double -> Double -> Int -> HIplImage MonoChromatic Word8 r -> 
                  [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -113,8 +114,9 @@ houghStandard rho theta threshold img = unsafePerformIO $
 -- transform. Parameters are @rho@, the distance resolution in pixels;
 -- @theta@, the angle resolution in radians; @threshold@, the line
 -- classification accumulator threshold; and the input image.
-houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage MonoChromatic Word8 -> [((Int, Int),(Int,Int))]
+houghProbabilistic :: ImgBuilder r =>
+                      Double -> Double -> Int -> Double -> Double -> 
+                      HIplImage MonoChromatic Word8 r -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -151,7 +153,8 @@ findContours img = snd $ withDuplicateImage img $
 -- |Resize the supplied 'HIplImage' to the given width and height using
 -- the supplied 'InterpolationMethod'.
 resize :: (HasChannels c, HasDepth d) => 
-          InterpolationMethod -> Int -> Int -> HIplImage c d -> HIplImage c d
+          InterpolationMethod -> Int -> Int -> HIplImage c d NoROI -> 
+          HIplImage c d NoROI
 resize method w h img = 
     unsafePerformIO $
     do img' <- mkHIplImage w h
@@ -164,8 +167,8 @@ resize method w h img =
 -- |Normalize the range of color values in an image to the given
 -- range. Example usage with a grayscale image is @normalize cv_MinMax
 -- 0 255 img@
-normalize :: (HasChannels c, HasDepth d) => 
-             ArrayNorm -> CDouble -> CDouble -> HIplImage c d -> HIplImage c d
+normalize :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+             ArrayNorm -> CDouble -> CDouble -> HIplImage c d r -> HIplImage c d r
 normalize ntype a b = cv2 $ \img dst -> 
                       cvNormalize img dst a b (unNorm ntype) nullPtr
 {-# INLINE normalize #-}
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index b967471..de227cc 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -19,11 +19,11 @@ foreign import ccall "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
 -- increments; the fifth is the size of the scanned neighborhood in
 -- pixels around the block. The result is a pair of the horizontal and
 -- vertical components of optical flow.
-calcOpticalFlowBM :: HIplImage MonoChromatic Word8 -> 
-                     HIplImage MonoChromatic Word8 -> 
+calcOpticalFlowBM :: HIplImage MonoChromatic Word8 r -> 
+                     HIplImage MonoChromatic Word8 r -> 
                      (Int,Int) -> (Int,Int) -> (Int,Int) -> 
-                     (HIplImage MonoChromatic Float, 
-                      HIplImage MonoChromatic Float)
+                     (HIplImage MonoChromatic Float NoROI, 
+                      HIplImage MonoChromatic Float NoROI)
 calcOpticalFlowBM prev curr blockSize shiftSize maxRange = 
     unsafePerformIO $
     do velX <- mkHIplImage w h 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index f3799bf..ea1b71d 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -20,7 +20,7 @@ import Unsafe.Coerce (unsafeCoerce)
 -- pixel data that excludes these unused bytes. If the original image
 -- data is already packed, it is returned as a 'V.Vector' without
 -- copying.
-packPixels :: (HasChannels c, HasDepth d) => HIplImage c d -> V.Vector d
+packPixels :: (HasChannels c, HasDepth d) => HIplImage c d NoROI -> V.Vector d
 packPixels img = 
     if w' == stride 
     then pixels img
@@ -46,7 +46,8 @@ packPixels img =
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: HasDepth d => Int -> HIplImage TriChromatic d -> V.Vector d
+isolateChannel :: HasDepth d => 
+                  Int -> HIplImage TriChromatic d NoROI -> V.Vector d
 isolateChannel ch img = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"
@@ -65,7 +66,8 @@ isolateChannel ch img =
 {-# INLINE isolateChannel #-}
 
 -- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, HasDepth d, Integral d) => HIplImage c d -> V.Vector d
+toMono :: (HasChannels c, HasDepth d, Integral d) => 
+          HIplImage c d NoROI -> V.Vector d
 toMono img = if imgChannels img == 1 then packPixels img
              else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
 
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index dbe6dda..9ab5c30 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -8,7 +8,6 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdBinaryOtsu, thresholdBinaryOtsuInv,
                                thresholdTruncateOtsu,
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
-import Control.Monad (void)
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
@@ -38,36 +37,43 @@ foreign import ccall "opencv2/imgproc/imgproc_c.h cvThreshold"
   c_cvThreshold :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> 
                    IO CDouble
 
-class ByteOrFloat a => Thresholdable a b where
-  doThreshold :: a -> a -> Int -> 
-                 HIplImage MonoChromatic a -> 
-                 HIplImage MonoChromatic b
+{-
+class ByteOrFloat a => Thresholdable r a b where
+  doThreshold :: (ImgBuilder r, InplaceROI r a MonoChromatic b MonoChromatic) => 
+                 a -> a -> Int -> 
+                 HIplImage MonoChromatic a r -> 
+                 HIplImage MonoChromatic b r
 
-instance Thresholdable Word8 Word8 where
+instance InplaceROI r MonoChromatic Word8 MonoChromatic Word8 =>
+         Thresholdable r Word8 Word8 where
   doThreshold = cvThreshold1
   {-# INLINE doThreshold #-}
 
-instance Thresholdable Float Float where
+instance InplaceROI r MonoChromatic Float MonoChromatic Float =>
+         Thresholdable r Float Float where
   doThreshold = cvThreshold1
   {-# INLINE doThreshold #-}
 
-instance Thresholdable Float Word8 where
+instance InplaceROI r MonoChromatic Float MonoChromatic Word8 =>
+         Thresholdable r Float Word8 where
   doThreshold = cvThreshold2
   {-# INLINE doThreshold #-}
-  
-cvThreshold1 :: ByteOrFloat a => a -> a -> Int -> 
-                HIplImage MonoChromatic a -> HIplImage MonoChromatic a
+
+cvThreshold1 :: (ByteOrFloat a, ImgBuilder r, InplaceROI r M a M a) => 
+                a -> a -> Int -> 
+                HIplImage MonoChromatic a r -> HIplImage MonoChromatic a r
 cvThreshold1 threshold maxValue tType =
   cv $ \src -> void $ c_cvThreshold src src threshold' maxValue' tType'
   where threshold' = realToFrac . toDouble $ threshold
         maxValue' = realToFrac . toDouble $ maxValue
         tType' = fromIntegral tType
 {-# INLINE cvThreshold1 #-}
+-}
 
 -- The worker function that calls c_cvThreshold.
-cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2) =>
-                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 ->
-                HIplImage MonoChromatic d2
+cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2, InplaceROI r M d1 M d2) =>
+                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 r ->
+                HIplImage MonoChromatic d2 r
 cvThreshold2 threshold maxValue tType = 
     cv2 $ \src dst ->
         do _r <- c_cvThreshold src dst threshold' maxValue' tType'
@@ -78,26 +84,35 @@ cvThreshold2 threshold maxValue tType =
           tType' = fromIntegral tType
 {-# INLINE cvThreshold2 #-}
 
-cvThreshold :: Thresholdable d1 d2 => d1 -> d1 -> Int -> 
-               HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
-cvThreshold = doThreshold
+-- cvThreshold :: (Thresholdable d1 d2, ImgBuilder r) => d1 -> d1 -> Int -> 
+--                HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+-- cvThreshold = doThreshold
+cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2, InplaceROI r M d1 M d2) =>
+               d1 -> d1 -> Int -> 
+               HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+cvThreshold = cvThreshold2
+
 {-# INLINE cvThreshold #-}
 
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
-cvThresholdOtsu :: Word8 -> Int -> HIplImage MonoChromatic Word8 ->
-                   HIplImage MonoChromatic Word8
+cvThresholdOtsu :: InplaceROI r M Word8 M Word8 =>
+                   Word8 -> Int -> HIplImage MonoChromatic Word8 r ->
+                   HIplImage MonoChromatic Word8 r
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
 {-# INLINE cvThresholdOtsu #-}
 
+type M = MonoChromatic
+
 -- |Binary thresholding. Parameters are the @threshold@ value, the
 -- @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
-thresholdBinary :: Thresholdable d1 d2 => d1 -> d1 -> 
-                   HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+thresholdBinary :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+                   d1 -> d1 -> 
+                   HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
 thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
@@ -105,8 +120,9 @@ thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 -- the @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
-thresholdBinaryInv :: Thresholdable d1 d2 => d1 -> d1 -> 
-                      HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+thresholdBinaryInv :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+                      d1 -> d1 -> 
+                      HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
 thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
@@ -115,24 +131,24 @@ thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
-thresholdTruncate :: Thresholdable d1 d2 => d1 ->
-                     HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+thresholdTruncate :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+                     d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
 thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
-thresholdToZero :: Thresholdable d1 d2 => d1 ->
-                   HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+thresholdToZero :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+                   d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
 thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
-thresholdToZeroInv :: Thresholdable d1 d2 => d1 ->
-                      HIplImage MonoChromatic d1 -> HIplImage MonoChromatic d2
+thresholdToZeroInv :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+                      d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
 thresholdToZeroInv threshold = cvThreshold threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
@@ -141,8 +157,9 @@ thresholdToZeroInv threshold = cvThreshold threshold 0 tType
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'.
-thresholdBinaryOtsu :: Word8 -> HIplImage MonoChromatic Word8 ->
-                       HIplImage MonoChromatic Word8
+thresholdBinaryOtsu :: (InplaceROI r M Word8 M Word8) =>
+                       Word8 -> HIplImage MonoChromatic Word8 r ->
+                       HIplImage MonoChromatic Word8 r
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
 {-# INLINE thresholdBinaryOtsu #-}
@@ -152,8 +169,9 @@ thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'. The sense of the
 -- thresholding operation is inverted, as in 'thresholdBinaryInv'.
-thresholdBinaryOtsuInv :: Word8 -> HIplImage MonoChromatic Word8 ->
-                          HIplImage MonoChromatic Word8
+thresholdBinaryOtsuInv :: (InplaceROI r M Word8 M Word8) =>
+                          Word8 -> HIplImage MonoChromatic Word8 r ->
+                          HIplImage MonoChromatic Word8 r
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryOtsuInv #-}
@@ -162,23 +180,26 @@ thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
 -- and returned along with the thresholded image.
-thresholdTruncateOtsu :: HIplImage MonoChromatic Word8 -> 
-                         HIplImage MonoChromatic Word8
+thresholdTruncateOtsu :: (InplaceROI r M Word8 M Word8) =>
+                         HIplImage MonoChromatic Word8 r -> 
+                         HIplImage MonoChromatic Word8 r
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncateOtsu #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged.The @threshold@ value is chosen
 -- using Otsu's method and returned along with the thresholded image.
-thresholdToZeroOtsu :: HIplImage MonoChromatic Word8 -> 
-                       HIplImage MonoChromatic Word8
+thresholdToZeroOtsu :: (InplaceROI r M Word8 M Word8) =>
+                       HIplImage MonoChromatic Word8 r -> 
+                       HIplImage MonoChromatic Word8 r
 thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZeroOtsu #-}
 
 -- |Maps pixels that are greather than @threshold@ to zero; leaves all
 -- other pixels unchaged.The @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
-thresholdToZeroOtsuInv :: HIplImage MonoChromatic Word8 -> 
-                          HIplImage MonoChromatic Word8
+thresholdToZeroOtsuInv :: (InplaceROI r M Word8 M Word8) =>
+                          HIplImage MonoChromatic Word8 r -> 
+                          HIplImage MonoChromatic Word8 r
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
 {-# INLINE thresholdToZeroOtsuInv #-}
diff --git a/src/AI/CV/OpenCV/Video.hs b/src/AI/CV/OpenCV/Video.hs
index 5a2a4bb..1950c97 100644
--- a/src/AI/CV/OpenCV/Video.hs
+++ b/src/AI/CV/OpenCV/Video.hs
@@ -30,7 +30,7 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
 -- available either due to error or the end of the video sequence,
 -- 'Nothing' is returned.
 createFileCapture :: (HasChannels c, HasDepth d) => 
-                     FilePath -> IO (IO (Maybe (HIplImage c d)))
+                     FilePath -> IO (IO (Maybe (HIplImage c d NoROI)))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ \cap ->
                                        do f <- cvQueryFrame cap
@@ -43,7 +43,7 @@ createFileCapture fname = do capture <- createFileCaptureF fname
 -- frames will return to its beginning when the end of the video is
 -- encountered.
 createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
-                         FilePath -> IO (IO (HIplImage c d))
+                         FilePath -> IO (IO (HIplImage c d NoROI))
 createFileCaptureLoop fname = do capture <- createFileCaptureF fname
                                  return (withForeignPtr capture $ 
                                          (>>= fromPtr) . queryFrameLoop)
@@ -54,7 +54,7 @@ createFileCaptureLoop fname = do capture <- createFileCaptureF fname
 -- matter what camera is used. The returned action may be used to
 -- query for the next available frame.
 createCameraCapture :: (HasChannels c, HasDepth d) =>
-                       Maybe Int -> IO (IO (HIplImage c d))
+                       Maybe Int -> IO (IO (HIplImage c d NoROI))
 createCameraCapture cam = do cvInit
                              capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
@@ -70,9 +70,9 @@ mpeg4CC = ('F','M','P','4')
 -- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
 -- created video stream, and the size of the video frames. The
 -- returned action may be used to add frames to the video stream.
-createVideoWriter :: (HasChannels c, HasDepth d) =>
+createVideoWriter :: (HasChannels c, HasDepth d, ImgBuilder r) =>
                      FilePath -> FourCC -> Double -> (Int,Int) -> 
-                     IO (HIplImage c d -> IO ())
+                     IO (HIplImage c d r -> IO ())
 createVideoWriter fname codec fps sz = 
     do writer <- createVideoWriterF fname codec fps sz
        let writeFrame img = withForeignPtr writer $ \writer' ->
diff --git a/src/Examples/Closing/Closing.hs b/src/Examples/OneOffs/Closing.hs
similarity index 100%
rename from src/Examples/Closing/Closing.hs
rename to src/Examples/OneOffs/Closing.hs
diff --git a/src/Examples/OneOffs/EqualizeCenter.hs b/src/Examples/OneOffs/EqualizeCenter.hs
new file mode 100644
index 0000000..c7c2644
--- /dev/null
+++ b/src/Examples/OneOffs/EqualizeCenter.hs
@@ -0,0 +1,12 @@
+import Control.Applicative
+import AI.CV.OpenCV.HighCV
+import AI.CV.OpenCV.ArrayOps
+import AI.CV.OpenCV.Histograms
+
+boostSaturation :: ColorImage -> ColorImage
+boostSaturation img = convertHSVToBGR $ replaceChannel 1 s hsv
+  where hsv = convertBGRToHSV img
+        s = withROI (CvRect 100 100 300 300) (convertScale 2 0) $ isolateChannel 1 hsv
+
+main = fromFileColor "../PerfTest/lena.jpg" >>=
+       toFile "eq.png" . boostSaturation
diff --git a/src/Examples/Closing/input.png b/src/Examples/OneOffs/input.png
similarity index 100%
rename from src/Examples/Closing/input.png
rename to src/Examples/OneOffs/input.png
diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index 6de52de..bba9699 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -40,15 +40,6 @@ twoTone g = light t `cvOr` dark t
 neonEdges :: GrayImage -> ColorImage
 neonEdges = convertGrayToRGB . smoothGaussian 3 . dilate 1 . canny 70 110 3
 
-neonEdges' :: ColorImage -> ColorImage
-neonEdges' x = hedges `cvOr` sedges `cvAnd` (cvNot vedges)
-  where hsv = convertBGRToHSV x
-        glow = convertGrayToRGB . smoothGaussian 5 . dilate 1 . canny 70 110 3
-        hedges = cvAndS (0,255,255) . glow . isolateChannel 0 $ hsv
-        sedges = cvAndS (0,255,120) . glow . isolateChannel 1 $ hsv
-        vedges = convertGrayToRGB . thresholdBinary 200 255 . smoothGaussian 5 . dilate 1 . canny 70 110 3 . isolateChannel 2 $ hsv
-{-# INLINE neonEdges #-}
-
 -- Boost saturation
 boostSat x = convertHSVToBGR $ replaceChannel 1 s' hsv
   where hsv = convertBGRToHSV x
@@ -59,7 +50,7 @@ boostSat x = convertHSVToBGR $ replaceChannel 1 s' hsv
 blueprint x = toned `par` neon `pseq` add neon toned
   where g = convertRGBToGray x
         toned = twoTone g
-        neon = neonEdges' x --g
+        neon = neonEdges g
 {-# INLINE blueprint #-}
 
 -- No parallelism

From 92a5560392bfeaddc673853b72113f6153bf4f53 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 17:45:36 -0400
Subject: [PATCH 105/137] Added array copy (useful with ROI).

---
 src/AI/CV/OpenCV/ArrayOps.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index b0f87fc..4dda545 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -6,7 +6,7 @@ module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale,
                               cvOr, cvOrS, set, setROI, resetROI,
                               mul, mulS, add, addS, sub, subMask,
                               cmpS, avg, avgMask, cvNot, withROI,
-                              ComparisonOp(..), isolateChannel, 
+                              ComparisonOp(..), isolateChannel, copy,
                               replaceChannel) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
@@ -338,3 +338,11 @@ replaceChannel n c = cv2 $ \src dst ->
                              cvMixChannels p1 2 p2 1 ft 3
   where n' = (n + 1) `rem` 3
         n'' = (n + 2) `rem` 3
+
+foreign import ccall "opencv2/core/core_c.h cvCopy"
+  cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
+
+copy :: (HasChannels c, HasDepth d, ImgBuilder r2) =>
+        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+copy src = cv $ \dst -> withHIplImage src $ \src' ->
+           cvCopy (castPtr src') dst nullPtr

From ccb81c06378cf3b41f6933f5f2bcb0c853f89fa0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 20 Jul 2011 17:47:31 -0400
Subject: [PATCH 106/137] Added the centralFocus video effect.

---
 src/Examples/VideoFunhouse/VideoFunhouse.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index bba9699..22c9652 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -46,6 +46,14 @@ boostSat x = convertHSVToBGR $ replaceChannel 1 s' hsv
         s' = convertScale 2.0 0 . isolateChannel 1 $ hsv
 {-# INLINE boostSat #-}
 
+-- Saturate and blur the borders
+centralFocus :: ColorImage -> ColorImage
+centralFocus img = withROI r (copy (setROI r img)) bg
+  where bg = smoothGaussian 35 . boostSat $ img
+        white = cvOrS (255,255,255) img
+        r = CvRect 150 100 340 280
+{-# INLINE centralFocus #-}
+
 -- A two-tone blueprint effect.
 blueprint x = toned `par` neon `pseq` add neon toned
   where g = convertRGBToGray x
@@ -119,6 +127,7 @@ main = do args <- getArgs
               checkKey b _ 54 = go b blueprint2      -- 6
               checkKey b _ 55 = go b blueprint2slow  -- 7
               checkKey b _ 56 = go b boostSat        -- 8
+              checkKey b _ 57 = go b centralFocus    -- 9
               checkKey b p 102 = go (not b) p
               checkKey _ _ 27 = close >> exitSuccess
               checkKey b p _ = go b p
@@ -153,6 +162,7 @@ showHelp = do p "Usage: VideoFunhouse [file]"
               p " 6 - A four-tone blueprint effect"
               p " 7 - Four-tone blueprint effect without par annotations"
               p " 8 - Saturation boost"
+              p " 9 - Focus on the middle"
               p ""
               p "Press Esc to exit."
     where p = putStrLn

From eaf15d1af8b47579417a36bfde1dc0451e2797cc Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Thu, 21 Jul 2011 15:21:13 -0400
Subject: [PATCH 107/137] Widespread renaming: MonoChromatic -> Monochromatic;
 TriChromatic -> Trichromatic; InplaceROI -> Inplace.

---
 src/AI/CV/OpenCV/ArrayOps.hs                |  77 ++++++-------
 src/AI/CV/OpenCV/ColorConversion.hs         |  42 +++----
 src/AI/CV/OpenCV/Core/CVOp.hs               |  71 +++++++++---
 src/AI/CV/OpenCV/Core/CxCore.hsc            |   1 +
 src/AI/CV/OpenCV/Core/HIplImage.hsc         | 119 ++++++++++++--------
 src/AI/CV/OpenCV/Core/HIplUtil.hs           |  42 ++++---
 src/AI/CV/OpenCV/FeatureDetection.hs        |  20 ++--
 src/AI/CV/OpenCV/Filtering.hsc              |   4 +-
 src/AI/CV/OpenCV/HighCV.hs                  |  16 +--
 src/AI/CV/OpenCV/Motion.hsc                 |   8 +-
 src/AI/CV/OpenCV/PixelUtils.hs              |   2 +-
 src/AI/CV/OpenCV/Threshold.hs               |  86 +++++++-------
 src/Examples/VideoFunhouse/Makefile         |   2 +-
 src/Examples/VideoFunhouse/VideoFunhouse.hs |   1 -
 14 files changed, 273 insertions(+), 218 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 4dda545..28e4ed3 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -3,7 +3,7 @@
 -- |Array operations.
 module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
                               cvAnd, andMask, scaleAdd, cvAndS,
-                              cvOr, cvOrS, set, setROI, resetROI,
+                              cvOr, cvOrS, set, 
                               mul, mulS, add, addS, sub, subMask,
                               cmpS, avg, avgMask, cvNot, withROI,
                               ComparisonOp(..), isolateChannel, copy,
@@ -18,18 +18,17 @@ import System.IO.Unsafe (unsafePerformIO)
 import AI.CV.OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), 
                                  cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
 import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.HIplImage (addROI, resetROI)
 import AI.CV.OpenCV.Core.CVOp
 
-type M = MonoChromatic
+type M = Monochromatic
 
 foreign import ccall "opencv2/core/core_c.h cvSubRS"
   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
--- |Compute @value - src[i]@ for every pixel in the source 'HIplImage'.
+-- |@subRS value src@ computes @value - src[i]@ for every pixel.
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
-          IsCvScalar s, s ~ CvScalar c d, InplaceROI r c d c d) =>
+          IsCvScalar s, s ~ CvScalar c d, Inplace r c d c d) =>
          s -> HIplImage c d r -> HIplImage c d r
 subRS value = cv2 $ \src dst -> c_cvSubRS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar value
@@ -39,7 +38,7 @@ foreign import ccall "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
-absDiff :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+absDiff :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
            HIplImage c d r -> HIplImage c d r -> HIplImage c d r
 absDiff src1 = cv2 $ \src2 dst -> 
                withHIplImage src1 $ \src1' ->
@@ -57,7 +56,7 @@ foreign import ccall "opencv2/core/core_c.h cvConvertScale"
 -- independentally. Parameters are @scale@, @shift@, and the source
 -- 'HIplImage'.
 convertScale :: (HasChannels c, HasDepth d1, HasDepth d2, ImgBuilder r,
-                 InplaceROI r c d1 c d2) =>
+                 Inplace r c d1 c d2) =>
                 Double -> Double -> HIplImage c d1 r -> 
                 HIplImage c d2 r
 convertScale scale shift = cv2 $ \src dst -> 
@@ -74,8 +73,8 @@ foreign import ccall "opencv2/core/core_c.h cvAnd"
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
 andMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
-            InplaceROI r3 c d c d) => 
-           HIplImage MonoChromatic Word8 r1 -> HIplImage c d r2 ->  
+            Inplace r3 c d c d) => 
+           HIplImage Monochromatic Word8 r1 -> HIplImage c d r2 ->  
            HIplImage c d r3 -> HIplImage c d r3
 andMask mask src1 = cv2 $ \src2 dst -> 
                     withHIplImage src1 $ \src1' -> 
@@ -84,7 +83,7 @@ andMask mask src1 = cv2 $ \src2 dst ->
 {-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
-cvAnd :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+cvAnd :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
           HIplImage c d r1 -> HIplImage c d r2 ->  HIplImage c d r2
 cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
              c_cvAnd (castPtr src1') src2 dst nullPtr
@@ -96,7 +95,7 @@ foreign import ccall "opencv2/core/core_c.h cvAndS"
 
 -- |Per-element bit-wise conjunction of an array and a scalar. 
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
-           s ~ CvScalar c d, InplaceROI r c d c d) => 
+           s ~ CvScalar c d, Inplace r c d c d) => 
           s -> HIplImage c d r -> HIplImage c d r
 cvAndS s = cv2 $ \img dst -> c_cvAndS img r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar s
@@ -110,7 +109,7 @@ foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
 -- src1 s src2@ computes @dst[i] = s*src1[i] + src2[i]@
 scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
              s ~ CvScalar c d, IsCvScalar s, ImgBuilder r1, 
-             InplaceROI r2 c d c d) => 
+             Inplace r2 c d c d) => 
             HIplImage c d r1 -> s -> HIplImage c d r2 -> HIplImage c d r2
 scaleAdd src1 s = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
@@ -125,7 +124,7 @@ cvMulHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Double -> IO ()
 cvMulHelper src1 src2 dst s = c_cvMul src1 src2 dst (realToFrac s)
 
 -- |Per-element product of two arrays.
-mul :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+mul :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 mul src1 = cv2 $ \src2 dst -> 
            withHIplImage src1 $ \src1' ->
@@ -134,7 +133,7 @@ mul src1 = cv2 $ \src2 dst ->
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
-mulS :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+mulS :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
         Double -> HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 mulS scale src1 = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
@@ -145,7 +144,7 @@ foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum.
-add :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) => 
+add :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 add src1 = cv2 $ \src2 dst ->
            withHIplImage src1 $ \src1' ->
@@ -158,7 +157,7 @@ foreign import ccall "opencv2/core/core_c.h cvAddS"
 
 -- |Computes the sum of an array and a scalar.
 addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
-         InplaceROI r c d c d) => 
+         Inplace r c d c d) => 
         s -> HIplImage c d r -> HIplImage c d r
 addS scalar = cv2 $ \src dst -> c_cvAddS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
@@ -168,7 +167,7 @@ foreign import ccall "opencv2/core/core_c.h cvSub"
   c_cvSub :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element difference.
-sub :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) =>
+sub :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) =>
        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 sub img1 = cv2 $ \img2 dst ->
            withHIplImage img1 $ \img1' -> 
@@ -180,8 +179,8 @@ sub img1 = cv2 $ \img2 dst ->
 -- that @dst@ is the same as @img1@ everywhere @mask@ is zero. This
 -- permits in-place updating of @img1@.
 subMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
-            InplaceROI r3 c d c d) =>
-           HIplImage c d r1 -> HIplImage MonoChromatic Word8 r2 -> HIplImage c d r3 -> 
+            Inplace r3 c d c d) =>
+           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> HIplImage c d r3 -> 
            HIplImage c d r3
 subMask img2 mask = cv $ \img1 ->
                     withHIplImage mask $ \mask' -> 
@@ -193,7 +192,7 @@ foreign import ccall "opencv2/core/core_c.h cvOr"
   c_cvOr :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise disjunction of two arrays
-cvOr :: (HasChannels c, HasDepth d, ImgBuilder r1, InplaceROI r2 c d c d) =>
+cvOr :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) =>
         HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 cvOr img1 = cv2 $ \img2 dst ->
             withHIplImage img1 $ \img1' -> 
@@ -206,7 +205,7 @@ foreign import ccall "opencv2/core/core_c.h cvOrS"
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
 cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
-          InplaceROI r c d c d) => 
+          Inplace r c d c d) => 
          s -> HIplImage c d r -> HIplImage c d r
 cvOrS scalar = cv2 $ \src dst -> c_cvOrS src r g b a dst nullPtr
     where (r,g,b,a) = toCvScalar scalar
@@ -218,28 +217,17 @@ foreign import ccall "opencv2/core/core_c.h cvSet"
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
 set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
-        InplaceROI r c d c d) => 
+        Inplace r c d c d) => 
        s -> HIplImage c d r -> HIplImage c d r
 set scalar = cv $ \src -> c_cvSet src r g b a nullPtr
     where (r,g,b,a) = toCvScalar scalar
 {-# INLINE set #-}
 
--- |Set an image's region-of-interest.
-setROI :: (HasChannels c, HasDepth d) => 
-          CvRect -> HIplImage c d r -> HIplImage c d HasROI
-setROI = addROI
-{-# INLINE setROI #-}
-
 setROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
             CvRect -> HIplImage c d r -> HIplImage c d HasROI
 setROICV (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
 {-# INLINE setROICV #-}
 
--- -- |Clear any region-of-interest set for an image.
---resetROI :: (HasChannels c, HasDepth d) => HIplImage c d r -> HIplImage c d NoROI
---resetROI = removeROI
--- {-# INLINE resetROI #-}
-
 resetROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
               HIplImage c d r -> HIplImage c d NoROI
 resetROICV = cv $ \img -> c_cvResetImageROI img
@@ -268,9 +256,9 @@ cmpToCmp CmpLE = unCmpOp cmpLE
 cmpToCmp CmpNE = unCmpOp cmpNE
 
 -- |Per-element comparison of an array and a scalar.
-cmpS :: (HasDepth d, InplaceROI r M d M Word8) => 
-        ComparisonOp -> d -> HIplImage MonoChromatic d r -> 
-        HIplImage MonoChromatic Word8 r
+cmpS :: (HasDepth d, Inplace r M d M Word8) => 
+        ComparisonOp -> d -> HIplImage Monochromatic d r -> 
+        HIplImage Monochromatic Word8 r
 cmpS op v = cv2 $ \src dst ->
             c_cvCmpS src v' dst (cmpToCmp op)
     where v' = realToFrac . toDouble $ v
@@ -296,7 +284,7 @@ avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr . castPtr
 -- is non-zero.
 avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
             ImgBuilder r1, ImgBuilder r2) => 
-           HIplImage c d r1 -> HIplImage MonoChromatic Word8 r2 -> CvScalar c d
+           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> CvScalar c d
 avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
                    withHIplImage mask $ avgWorker (castPtr src) . castPtr
 {-# NOINLINE avgMask #-}
@@ -305,7 +293,7 @@ foreign import ccall "opencv2/core/core_c.h cvNot"
   c_cvNot :: Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise inversion.
-cvNot :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+cvNot :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
          HIplImage c d r -> HIplImage c d r
 cvNot = cv2 $ \src dst -> c_cvNot src dst
 {-# INLINE cvNot #-}
@@ -315,21 +303,22 @@ foreign import ccall "opencv2/core/core_c.h cvMixChannels"
                    Ptr CInt -> CInt -> IO ()
 
 -- |Isolate a specific channel from a trichromatic image.
-isolateChannel :: (HasDepth d, InplaceROI r TriChromatic d M d) =>
-                  CInt -> HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
+isolateChannel :: (HasDepth d, Inplace r Trichromatic d M d) =>
+                  CInt -> HIplImage Trichromatic d r -> HIplImage Monochromatic d r
 isolateChannel n = cv2 $ \src dst -> 
                    alloca $ \p1 -> poke p1 src >>
                                    (alloca $ \p2 ->
                                      poke p2 dst >>
                                      (withArray [n,0] $ \ft ->
                                        cvMixChannels p1 1 p2 1 ft 1))
+{-# INLINE isolateChannel #-}
 
 -- |Replace a specific channel of a trichromatic image with the single
 -- channel from a monochromatic image.
 replaceChannel :: (HasDepth d, ImgBuilder r1, 
-                   InplaceROI r2 TriChromatic d TriChromatic d) => 
-                  CInt -> HIplImage MonoChromatic d r1 -> 
-                  HIplImage TriChromatic d r2 -> HIplImage TriChromatic d r2
+                   Inplace r2 Trichromatic d Trichromatic d) => 
+                  CInt -> HIplImage Monochromatic d r1 -> 
+                  HIplImage Trichromatic d r2 -> HIplImage Trichromatic d r2
 replaceChannel n c = cv2 $ \src dst -> 
                      withHIplImage c $ \cp ->
                        withArray [castPtr cp, src] $ \p1 -> 
@@ -338,6 +327,7 @@ replaceChannel n c = cv2 $ \src dst ->
                              cvMixChannels p1 2 p2 1 ft 3
   where n' = (n + 1) `rem` 3
         n'' = (n + 2) `rem` 3
+{-# INLINE replaceChannel #-}
 
 foreign import ccall "opencv2/core/core_c.h cvCopy"
   cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
@@ -346,3 +336,4 @@ copy :: (HasChannels c, HasDepth d, ImgBuilder r2) =>
         HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
 copy src = cv $ \dst -> withHIplImage src $ \src' ->
            cvCopy (castPtr src') dst nullPtr
+{-# INLINE copy #-}
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/AI/CV/OpenCV/ColorConversion.hs
index 080ad4f..07dcf09 100644
--- a/src/AI/CV/OpenCV/ColorConversion.hs
+++ b/src/AI/CV/OpenCV/ColorConversion.hs
@@ -10,57 +10,57 @@ import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.ColorConversion
 import AI.CV.OpenCV.Core.CVOp
 
-type M = MonoChromatic
-type T = TriChromatic
+type M = Monochromatic
+type T = Trichromatic
 
-convertGrayToRGB :: (HasDepth d, InplaceROI r M d T d) =>
-                    HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
+convertGrayToRGB :: (HasDepth d, Inplace r M d T d) =>
+                    HIplImage Monochromatic d r -> HIplImage Trichromatic d r
 convertGrayToRGB = convertColor cv_GRAY2RGB
 {-# INLINE convertGrayToRGB #-}
 
-convertGrayToBGR :: (HasDepth d, InplaceROI r M d T d) =>
-                    HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
+convertGrayToBGR :: (HasDepth d, Inplace r M d T d) =>
+                    HIplImage Monochromatic d r -> HIplImage Trichromatic d r
 convertGrayToBGR = convertColor cv_GRAY2BGR
 {-# INLINE convertGrayToBGR #-}
 
-convertBGRToGray :: (HasDepth d, InplaceROI r T d M d) =>
-                    HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
+convertBGRToGray :: (HasDepth d, Inplace r T d M d) =>
+                    HIplImage Trichromatic d r -> HIplImage Monochromatic d r
 convertBGRToGray = convertColor cv_BGR2GRAY
 {-# INLINE convertBGRToGray #-}
 
-convertRGBToGray :: (HasDepth d, InplaceROI r T d M d) =>
-                    HIplImage TriChromatic d r -> HIplImage MonoChromatic d r
+convertRGBToGray :: (HasDepth d, Inplace r T d M d) =>
+                    HIplImage Trichromatic d r -> HIplImage Monochromatic d r
 convertRGBToGray = convertBGRToGray
 {-# INLINE convertRGBToGray #-}
 
-convertBayerBgToBGR :: (HasDepth d, InplaceROI r M d T d) =>
-                       HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
+convertBayerBgToBGR :: (HasDepth d, Inplace r M d T d) =>
+                       HIplImage Monochromatic d r -> HIplImage Trichromatic d r
 convertBayerBgToBGR = convertColor cv_BayerBG2BGR
 {-# INLINE convertBayerBgToBGR #-}
 
-convertBayerBgToRGB :: (HasDepth d, InplaceROI r M d T d) =>
-                       HIplImage MonoChromatic d r -> HIplImage TriChromatic d r
+convertBayerBgToRGB :: (HasDepth d, Inplace r M d T d) =>
+                       HIplImage Monochromatic d r -> HIplImage Trichromatic d r
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
 {-# INLINE convertBayerBgToRGB #-}
 
-convertRGBToHSV :: (HasDepth d, InplaceROI r T d T d) =>
-                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
+convertRGBToHSV :: (HasDepth d, Inplace r T d T d) =>
+                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
 convertRGBToHSV = convertColor cv_RGB2HSV
 {-# INLINE convertRGBToHSV #-}
 
-convertBGRToHSV :: (HasDepth d, InplaceROI r T d T d) =>
-                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
+convertBGRToHSV :: (HasDepth d, Inplace r T d T d) =>
+                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
 convertBGRToHSV = convertColor cv_BGR2HSV
 {-# INLINE convertBGRToHSV #-}
 
-convertHSVToBGR :: (HasDepth d, InplaceROI r T d T d) =>
-                   HIplImage TriChromatic d r -> HIplImage TriChromatic d r
+convertHSVToBGR :: (HasDepth d, Inplace r T d T d) =>
+                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
 convertHSVToBGR = convertColor cv_HSV2BGR
 {-# INLINE convertHSVToBGR #-}
 
 -- |Convert the color model of an image.
 convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, 
-                 InplaceROI r c1 d c2 d) =>
+                 Inplace r c1 d c2 d) =>
                 ColorConversion -> HIplImage c1 d r -> HIplImage c2 d r
 convertColor cc = cv2 $ \src dst -> cvCvtColor src dst cc
 {-# INLINE convertColor #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index 05fae2a..ad493bb 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances,
+             TypeSynonymInstances #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 --
@@ -17,7 +18,7 @@
 -- with such an operation, must have a destination image
 -- allocated. This is cheaper than duplicating the input image as with
 -- operations wrapped by the `cv` combinator.
-module AI.CV.OpenCV.Core.CVOp (cv, InplaceROI(..)) where
+module AI.CV.OpenCV.Core.CVOp (cv, Inplace(..)) where
 import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.HIplImage
@@ -83,63 +84,97 @@ unary2bi = BinOp . const . op
 (<>) = mappend
 {-# INLINE (<>) #-}
 
--- Some operations really benefit from operating in-place over a defined ROI.
+-- |Some operations benefit from operating in-place over a defined
+-- region-of-interest (ROI). If an operation must recompute every
+-- pixel of the result image, then there is no need to initialize a
+-- fresh destination image to the contents of the source
+-- image. However, if we will only be recomputing a ROI of the source
+-- image, then the result image should be initialized as a copy of the
+-- source image so that its contents outside the ROI match the
+-- original image.
 class (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) =>
-      InplaceROI r c1 d1 c2 d2 where
+      Inplace r c1 d1 c2 d2 where
   cv2 :: IplArrayType e =>
            (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c, HasDepth d) => InplaceROI HasROI c d c d where
+-- | We clone an image and operate within its ROI if the source and
+-- destination images are compatible (same number of channels and
+-- pixel depth).
+instance (HasChannels c, HasDepth d) => Inplace HasROI c d c d where
   cv2 = cv . dupArg
   {-# INLINE cv2 #-}
 
 instance (HasDepth d1, HasDepth d2) => 
-         InplaceROI HasROI TriChromatic d1 MonoChromatic d2 where
+         Inplace HasROI Trichromatic d1 Monochromatic d2 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasDepth d1, HasDepth d2) => 
-         InplaceROI HasROI MonoChromatic d1 TriChromatic d2 where
+         Inplace HasROI Monochromatic d1 Trichromatic d2 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Word8 c2 Float where
+         Inplace HasROI c1 Word8 c2 Float where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Word8 c2 Word16 where
+         Inplace HasROI c1 Word8 c2 Word16 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Word8 c2 Double where
+         Inplace HasROI c1 Word8 c2 Double where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Double c2 Word8 where
+         Inplace HasROI c1 Word16 c2 Word8 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Word16 c2 Word8 where
-  cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
-
-instance (HasChannels c1, HasChannels c2) => 
-         InplaceROI HasROI c1 Float c2 Word8 where
+         Inplace HasROI c1 Float c2 Word8 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 instance (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
-         InplaceROI NoROI c1 d1 c2 d2 where
+         Inplace NoROI c1 d1 c2 d2 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
+-- If the source and destination are not compatible, then it doesn't
+-- matter if there is a ROI set as we can never operate in-place.
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Float c2 Word16 where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Float c2 Double where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Word16 c2 Float where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Word16 c2 Double where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Double c2 Float where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Double c2 Word16 where
+
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Double c2 Word8 where
+
+
+
+
+
+
+
 newtype BinOp a b = 
     BinOp { binop :: Ptr CvArr -> Ptr CvArr -> IO () }
 
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index cb393a2..622ab92 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -74,6 +74,7 @@ instance Storable CvRect where
         (#poke CvRect, width) ptr w
         (#poke CvRect, height) ptr h
 
+-- |Apply a function to each component of a 'CvRect'.
 liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect
 liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h)
     where f' = toFromIntegral f
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index d3ebc47..c162969 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -1,14 +1,23 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
-             BangPatterns, FlexibleContexts #-}
+             BangPatterns, FlexibleContexts, TypeSynonymInstances #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
-module AI.CV.OpenCV.Core.HIplImage 
-    ( TriChromatic, MonoChromatic, HasChannels(..), HasDepth(..), 
-      HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
-      ByteOrFloat, HasScalar(..), IsCvScalar(..), freeROI, c_cvSetImageROI, 
-      c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
-      widthStep, imageDataOrigin, addROI, resetROI, ImgBuilder(..), 
-      HasROI, NoROI) where
+module AI.CV.OpenCV.Core.HIplImage (
+    -- * Phantom types that statically describe image properties
+    Trichromatic, Monochromatic, HasROI, NoROI,
+
+    -- * Value-level reification of type-level properties
+    HasChannels(..), HasDepth(..), 
+
+    -- * Typed support for image operations that take scalar (color) parameters
+    HasScalar(..), IsCvScalar(..),
+
+    -- * Low-level image data structure
+    HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
+    freeROI, c_cvSetImageROI, 
+    c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
+    widthStep, imageDataOrigin, setROI, resetROI, ImgBuilder(..)
+  ) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
                                  iplDepth32f, iplDepth64f, cvFree, CvRect(..))
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
@@ -55,19 +64,40 @@ typedef struct _IplImage
 IplImage;
 -}
 
-data TriChromatic
-data MonoChromatic
+-- *Phantom types that statically describe image properties
+data Trichromatic
+data Monochromatic
+data HasROI
+data NoROI
+
+-- Rather than the unrelated HasROI and NoROI type tags, we can close
+-- the family by using a GADT to define the necessary singleton
+-- types. The downside is GHC gives: "Warning: Defined but not used:
+-- data constructor `HasROI'". To avoid this warning, I'll stick with
+-- the separate type definitions.
+
+-- data True
+-- data False
+
+-- data ROIProp a where
+--   HasROI :: ROIProp True
+--   NoROI  :: ROIProp False
 
+-- type HasROI = ROIProp True
+-- type NoROI = ROIProp False
+
+-- * Value-level reification of properties encoded in phantom types
 class HasChannels a where
     numChannels :: a -> CInt
 
+instance HasChannels Trichromatic where numChannels _ = 3
+instance HasChannels Monochromatic where numChannels _ = 1
+
 class (Storable a, Num a) => HasDepth a where
     depth      :: a -> Depth
     toDouble   :: a -> Double
     fromDouble :: Double -> a
 
-instance HasChannels TriChromatic where numChannels _ = 3
-instance HasChannels MonoChromatic where numChannels _ = 1
 instance HasDepth Word8 where 
     depth _ = iplDepth8u
     toDouble = fromIntegral
@@ -85,15 +115,6 @@ instance HasDepth Double where
     toDouble = id
     fromDouble = id
 
-class (HasDepth a, Num a) => ByteOrFloat a where
-instance ByteOrFloat Word8 where
-instance ByteOrFloat Float where
-
--- FIXME: Perhaps it would be better to use a distinct type for the
--- scalar type of color images? I'm having some trouble getting this
--- type to fit in, though.
---data RGB d = RGB !d !d !d
-
 -- |An image with a particular number of channels have an associated
 -- scalar type built from the type of its pixels. This class lets us
 -- ensure that a scalar value to be used in an operation with an image
@@ -101,12 +122,15 @@ instance ByteOrFloat Float where
 class HasDepth d => HasScalar c d where
     type CvScalar c d
 
-instance HasDepth d => HasScalar MonoChromatic d where
-    type CvScalar MonoChromatic d = d
+instance HasDepth d => HasScalar Monochromatic d where
+    type CvScalar Monochromatic d = d
 
-instance HasDepth d => HasScalar TriChromatic d where
-    type CvScalar TriChromatic d = (d,d,d)
+instance HasDepth d => HasScalar Trichromatic d where
+    type CvScalar Trichromatic d = (d,d,d)
 
+-- |Scalar types are often round-tripped via doubles in OpenCV to
+-- allow for non-overloaded interfaces of functions with scalar
+-- parameters.
 class IsCvScalar x where
     toCvScalar :: x -> (CDouble, CDouble, CDouble, CDouble)
     fromCvScalar :: (CDouble, CDouble, CDouble, CDouble) -> x
@@ -141,12 +165,6 @@ bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
     where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
 
--- |A data structure representing the information OpenCV uses from an
--- 'IplImage' struct. It includes the pixel origin, image width, image
--- height, image size (number of bytes), a pointer to the pixel data,
--- and the row stride. Its type is parameterized by the number of
--- color channels (i.e. 'MonoChromatic' or 'TriChromatic'), and the
--- pixel depth (e.g. 'Word8', 'Float').
 -- data HIplImage c d = (HasChannels c, HasDepth d) => 
 --                      HIplImage { origin          :: {-# UNPACK #-} !CInt
 --                                , width           :: {-# UNPACK #-} !CInt
@@ -157,9 +175,13 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 --                                , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
 --                                , widthStep       :: {-# UNPACK #-} !CInt }
 
-data HasROI
-data NoROI
-
+-- |A data structure representing the information OpenCV uses from an
+-- 'IplImage' struct. It includes the pixel origin, image width, image
+-- height, image size (number of bytes), a pointer to the pixel data,
+-- and the row stride. Its type is parameterized by the number of
+-- color channels (i.e. 'Monochromatic' or 'Trichromatic'), the pixel
+-- depth (e.g. 'Word8', 'Float'), and whether or not the image has a
+-- region-of-interest (ROI) set ('HasROI' or 'NoROI').
 data HIplImage c d r where
   Img :: (HasChannels c, HasDepth d) => 
          !CInt -> !CInt -> !CInt -> !CInt -> !(ForeignPtr d) -> !(ForeignPtr d) -> 
@@ -196,11 +218,13 @@ height (ImgR _ _ h _ _ _ _ _) = h
 widthStep (Img _ _ _ _ _ _ ws) = ws
 widthStep (ImgR _ _ _ _ _ _ _ ws) = ws
 
-addROI :: CvRect -> HIplImage c d r -> HIplImage c d HasROI
-addROI r (Img o w h sz d ido ws) = ImgR o w h r sz d ido ws
-addROI r (ImgR o w h _ sz d ido ws) = ImgR o w h r sz d ido ws
-{-# INLINE addROI #-}
+-- |Set an image's region-of-interest.
+setROI :: CvRect -> HIplImage c d r -> HIplImage c d HasROI
+setROI r (Img o w h sz d ido ws) = ImgR o w h r sz d ido ws
+setROI r (ImgR o w h _ sz d ido ws) = ImgR o w h r sz d ido ws
+{-# INLINE setROI #-}
 
+-- |Clear any region-of-interest set for an image.
 resetROI :: HIplImage c d r -> HIplImage c d NoROI
 resetROI x@(Img _ _ _ _ _ _ _) = x
 resetROI (ImgR o w h _ sz d ido ws) = Img o w h sz d ido ws
@@ -310,19 +334,16 @@ instance ImgBuilder NoROI where
 instance ImgBuilder HasROI where
   buildImg o w h (Just r) sz d ido ws = ImgR o w h r sz d ido ws
   buildImg _ _ _ _ _ _ _ _ = error "Building a ROI image, but wasn't given a ROI!"
-  addMaybeROI (Just r) x = addROI r x
+  addMaybeROI (Just r) x = setROI r x
   addMaybeROI _ _ = error "addMaybeROI tried to add a null ROI to a HasROI Image!"
 
--- |An 'HIplImage' in Haskell is isomorphic with OpenCV's 'IplImage'
--- structure type. They share the same binary representation through
--- 'HIplImage' \'s 'Storable' instance. This allows for safe casts
--- between pointers of the two types. Note that obtaining an
--- 'HIplImage' from an 'IplImage' via 'peek' will not install a
--- Haskell finalizer on the underlying pixel data. That data is the
--- responsibility of the provider of the 'IplImage'. 'HIplImage'
--- values constructed within the Haskell runtime, on the other hand,
--- do have their underlying pixel data buffers registered with a
--- finalizer.
+-- |An 'HIplImage' in Haskell conforms closely to OpenCV's 'IplImage'
+-- structure type. Note that obtaining an 'HIplImage' from an
+-- 'IplImage' via 'peek' will not install a Haskell finalizer on the
+-- underlying pixel data. That data is the responsibility of the
+-- provider of the 'IplImage'. 'HIplImage' values constructed within
+-- the Haskell runtime, on the other hand, will have their underlying
+-- pixel data buffers managedy by the garbage collector.
 instance forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
     Storable (HIplImage c d r) where
     sizeOf _ = (#size IplImage)
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index cfa6d06..7ba5678 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -6,9 +6,9 @@ module AI.CV.OpenCV.Core.HIplUtil
      fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
-     withDuplicateImage, withCompatibleImage, 
+     withDuplicateImage, withCompatibleImage, setROI, resetROI,
      mkHIplImage, width, height, mkBlackImage, HIplImage, NoROI, HasROI,
-     withHIplImage, MonoChromatic, TriChromatic, HasChannels, ImgBuilder(..),
+     withHIplImage, Monochromatic, Trichromatic, HasChannels, ImgBuilder(..),
      GrayImage, GrayImage16, ColorImage, c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
@@ -32,25 +32,30 @@ import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode,
                   IOMode(..))
 import System.IO.Unsafe
 
+-- |Some operations are restricted to bytes or floats.
+class (HasDepth a, Num a) => ByteOrFloat a where
+instance ByteOrFloat Word8 where
+instance ByteOrFloat Float where
+
 -- |Grayscale 8-bit (per-pixel) image type.
-type GrayImage = HIplImage MonoChromatic Word8 NoROI
+type GrayImage = HIplImage Monochromatic Word8 NoROI
 
 -- |Grayscale 16-bit (per-pixel) image type.
-type GrayImage16 = HIplImage MonoChromatic Word16 NoROI
+type GrayImage16 = HIplImage Monochromatic Word16 NoROI
 
 -- |Color 8-bit (per-color) image type.
-type ColorImage = HIplImage TriChromatic Word8 NoROI
+type ColorImage = HIplImage Trichromatic Word8 NoROI
 
 -- |This is a way to let the type checker know that you belieave an
 -- image to be tri-chromatic. If your image type can't be inferred any
 -- other way, this is an alternative to adding a type annotation.
-isColor :: HIplImage TriChromatic d r -> HIplImage TriChromatic d r
+isColor :: HIplImage Trichromatic d r -> HIplImage Trichromatic d r
 isColor = id
 
 -- |This is a way to let the type checker know that you believe an
 -- image to be monochromatic. If your image type can't be inferred any
 -- other way, this is an alternative to adding a type annotation.
-isMono :: HIplImage MonoChromatic d r -> HIplImage MonoChromatic d r
+isMono :: HIplImage Monochromatic d r -> HIplImage Monochromatic d r
 isMono = id
 
 {-# INLINE isMono #-}
@@ -97,11 +102,11 @@ checkFile f = do e <- doesFileExist f
 
 -- |Load a color 'HIplImage' from an 8-bit image file. If the image
 -- file is grayscale, it will be converted to color.
-fromFileColor :: FilePath -> IO (HIplImage TriChromatic Word8 NoROI)
+fromFileColor :: FilePath -> IO (HIplImage Trichromatic Word8 NoROI)
 fromFileColor fileName = 
   do checkFile fileName
      ptr <- cvLoadImage fileName LoadColor
-     img <- fromPtr ptr :: IO (HIplImage TriChromatic Word8 NoROI)
+     img <- fromPtr ptr :: IO (HIplImage Trichromatic Word8 NoROI)
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      freeROI ptr
      cvFree ptr
@@ -109,24 +114,27 @@ fromFileColor fileName =
 
 -- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
 -- image file is color, it will be converted to grayscale.
-fromFileGray :: FilePath -> IO (HIplImage MonoChromatic Word8 NoROI)
+fromFileGray :: FilePath -> IO (HIplImage Monochromatic Word8 NoROI)
 fromFileGray fileName = 
   do checkFile fileName
      ptr <- cvLoadImage fileName LoadGray
-     img <- fromPtr ptr :: IO (HIplImage MonoChromatic Word8 NoROI)
+     img <- fromPtr ptr :: IO (HIplImage Monochromatic Word8 NoROI)
      addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
      return img
 
+-- |If the type of a loaded image is known (e.g. by a type annotation,
+-- or usage of a narrowly typed functions), then we can automatically
+-- dispatch to the proper image loading routine.
 class LoadableFormat c d where
   loadFormat :: (c,d) -> FilePath -> IO (HIplImage c d NoROI)
 
-instance LoadableFormat MonoChromatic Word8 where
+instance LoadableFormat Monochromatic Word8 where
   loadFormat _ = fromFileGray
 
-instance LoadableFormat TriChromatic Word8 where
+instance LoadableFormat Trichromatic Word8 where
   loadFormat _ = fromFileColor
 
-instance LoadableFormat MonoChromatic Word16 where
+instance LoadableFormat Monochromatic Word16 where
   loadFormat _ = fromPGM16
 
 -- |An overloaded image file loader. The number of color channels and
@@ -140,7 +148,7 @@ fromFile = loadFormat (undefined :: (c,d))
 -- so this 16bpp loader is restricted to PGM. This loading routine
 -- converts from Most Significant Byte first (MSB) byte ordering (as
 -- per the PGM spec) to LSB byte ordering for x86 compatibility.
-fromPGM16 :: FilePath -> IO (HIplImage MonoChromatic Word16 NoROI)
+fromPGM16 :: FilePath -> IO (HIplImage Monochromatic Word16 NoROI)
 fromPGM16 fileName = 
   do checkFile fileName
      h <- openFile fileName ReadMode
@@ -261,14 +269,14 @@ fromPixels w h pix = unsafePerformIO $
 -- data. Parameters are the output image's width, height, and pixel
 -- content.
 fromGrayPixels :: (HasDepth d, Integral a) => 
-                  a -> a -> V.Vector d -> HIplImage MonoChromatic d NoROI
+                  a -> a -> V.Vector d -> HIplImage Monochromatic d NoROI
 fromGrayPixels w h = isMono . fromPixels w h
 
 -- |Helper function to explicitly type a vector of interleaved
 -- trichromatic pixel data. Parameters are the output image's width,
 -- height, and pixel content.
 fromColorPixels :: (HasDepth d, Integral a) =>
-                   a -> a -> V.Vector d -> HIplImage TriChromatic d NoROI
+                   a -> a -> V.Vector d -> HIplImage Trichromatic d NoROI
 fromColorPixels w h = isColor . fromPixels w h
 
 -- |Provides the supplied function with a 'Ptr' to the 'IplImage'
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 9a1f700..8780717 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -16,13 +16,13 @@ harris src dst blockSize aperture k =
     where fi = fromIntegral
           rf = realToFrac
 
-type M = MonoChromatic
+type M = Monochromatic
 
 -- |Equivalent to 'cornerHarris'' with an @aperture@ of @3@ and a @k@
 -- of @0.04@.
-cornerHarris :: (ByteOrFloat d, InplaceROI r M d M Float) => 
-                Int -> HIplImage MonoChromatic d r -> 
-                HIplImage MonoChromatic Float r
+cornerHarris :: (ByteOrFloat d, Inplace r M d M Float) => 
+                Int -> HIplImage Monochromatic d r -> 
+                HIplImage Monochromatic Float r
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 {-# INLINE cornerHarris #-}
 
@@ -34,9 +34,9 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 -- @aperture@ size to be used by the Sobel operator that is run during
 -- corner evaluation, the value of @k@, and the source
 -- 'HIplImage'.
-cornerHarris' :: (ByteOrFloat d, InplaceROI r M d M Float) => 
-                 Int -> Int -> Double -> HIplImage MonoChromatic d r -> 
-                 HIplImage MonoChromatic Float r
+cornerHarris' :: (ByteOrFloat d, Inplace r M d M Float) => 
+                 Int -> Int -> Double -> HIplImage Monochromatic d r -> 
+                 HIplImage Monochromatic Float r
 cornerHarris' blockSize aperture k = 
     cv2 $ \src dst -> harris src dst blockSize aperture k
 {-# INLINE cornerHarris' #-}
@@ -49,9 +49,9 @@ foreign import ccall "opencv2/imgprog/imgproc_c.h cvCanny"
 -- thresholds used to find initial segments of strong edges while the
 -- smaller threshold is used for edge linking. The third parameter is
 -- the aperture size used for initial Sobel operator edge detection.
-canny :: (HasDepth d, InplaceROI r M d M d) =>
-         Double -> Double -> Int -> HIplImage MonoChromatic d r -> 
-         HIplImage MonoChromatic d r
+canny :: (HasDepth d, Inplace r M d M d) =>
+         Double -> Double -> Int -> HIplImage Monochromatic d r -> 
+         HIplImage Monochromatic d r
 canny t1 t2 aperture = 
     cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
     --cv $ \src -> c_cvCanny src src (rf t1) (rf t2) (fi aperture)
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index a4801c8..50a0cd2 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -31,7 +31,7 @@ cvGaussian = #{const CV_GAUSSIAN}
 -- the kernel size. This function is the same as calling
 -- @smoothGaussian' width Nothing Nothing@. May be performed in-place
 -- under composition.
-smoothGaussian :: (ByteOrFloat d, HasChannels c, InplaceROI r c d c d) => 
+smoothGaussian :: (ByteOrFloat d, HasChannels c, Inplace r c d c d) => 
                   Int -> HIplImage c d r -> HIplImage c d r
 smoothGaussian w = smoothGaussian' w Nothing Nothing
 {-# INLINE smoothGaussian #-}
@@ -42,7 +42,7 @@ smoothGaussian w = smoothGaussian' w Nothing Nothing
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
 -- calculated from the kernel size), and the source image. May be
 -- performed in-place under composition.
-smoothGaussian' :: (ByteOrFloat d, HasChannels c, InplaceROI r c d c d) => 
+smoothGaussian' :: (ByteOrFloat d, HasChannels c, Inplace r c d c d) => 
                    Int -> Maybe Int -> Maybe Double -> HIplImage c d r -> 
                    HIplImage c d r
 smoothGaussian' w h sigma = 
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index d38f80a..7ce6d56 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -16,7 +16,7 @@ module AI.CV.OpenCV.HighCV (
                             sampleLine, getRect,
                             -- * Image Processing
                             erode, dilate, houghStandard, houghProbabilistic, 
-                            normalize, resize, 
+                            normalize, resize, setROI, resetROI,
                             module AI.CV.OpenCV.ColorConversion,
                             module AI.CV.OpenCV.Threshold,
                             module AI.CV.OpenCV.FloodFill,
@@ -31,7 +31,7 @@ module AI.CV.OpenCV.HighCV (
                             -- * Video
                             module AI.CV.OpenCV.Video,
                             -- * Image types
-                            HIplImage, MonoChromatic, TriChromatic, 
+                            HIplImage, Monochromatic, Trichromatic, 
                             HasChannels, HasDepth, 
                             GrayImage, ColorImage, GrayImage16, 
                             Word8, Word16
@@ -55,14 +55,14 @@ import AI.CV.OpenCV.Video
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-erode :: (HasChannels c, HasDepth d, InplaceROI r c d c d) =>
+erode :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
          Int -> HIplImage c d r -> HIplImage c d r
 erode n = cv2 $ \src dst -> cvErode src dst (fromIntegral n)
 {-# INLINE erode #-}
 
 -- |Dilate an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: (HasChannels c, HasDepth d, InplaceROI r c d c d) =>
+dilate :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
           Int -> HIplImage c d r -> HIplImage c d r
 dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
 {-# INLINE dilate #-}
@@ -82,7 +82,7 @@ sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $
 -- pixels; @theta@, the angle resolution in radians; @threshold@, the
 -- line classification accumulator threshold; and the input image.
 houghStandard :: ImgBuilder r =>
-                 Double -> Double -> Int -> HIplImage MonoChromatic Word8 r -> 
+                 Double -> Double -> Int -> HIplImage Monochromatic Word8 r -> 
                  [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -116,7 +116,7 @@ houghStandard rho theta threshold img = unsafePerformIO $
 -- classification accumulator threshold; and the input image.
 houghProbabilistic :: ImgBuilder r =>
                       Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage MonoChromatic Word8 r -> [((Int, Int),(Int,Int))]
+                      HIplImage Monochromatic Word8 r -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -139,7 +139,7 @@ houghProbabilistic rho theta threshold minLength maxGap img =
 
 {-
 -- |Find the 'CvContour's in an image.
-findContours :: HIplImage a MonoChromatic Word8 -> [CvContour]
+findContours :: HIplImage a Monochromatic Word8 -> [CvContour]
 findContours img = snd $ withDuplicateImage img $
                      \src -> cvFindContours src CV_RETR_CCOMP CV_CHAIN_APPROX_SIMPLE
 -}
@@ -167,7 +167,7 @@ resize method w h img =
 -- |Normalize the range of color values in an image to the given
 -- range. Example usage with a grayscale image is @normalize cv_MinMax
 -- 0 255 img@
-normalize :: (HasChannels c, HasDepth d, InplaceROI r c d c d) => 
+normalize :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
              ArrayNorm -> CDouble -> CDouble -> HIplImage c d r -> HIplImage c d r
 normalize ntype a b = cv2 $ \img dst -> 
                       cvNormalize img dst a b (unNorm ntype) nullPtr
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/AI/CV/OpenCV/Motion.hsc
index de227cc..40769de 100644
--- a/src/AI/CV/OpenCV/Motion.hsc
+++ b/src/AI/CV/OpenCV/Motion.hsc
@@ -19,11 +19,11 @@ foreign import ccall "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
 -- increments; the fifth is the size of the scanned neighborhood in
 -- pixels around the block. The result is a pair of the horizontal and
 -- vertical components of optical flow.
-calcOpticalFlowBM :: HIplImage MonoChromatic Word8 r -> 
-                     HIplImage MonoChromatic Word8 r -> 
+calcOpticalFlowBM :: HIplImage Monochromatic Word8 r -> 
+                     HIplImage Monochromatic Word8 r -> 
                      (Int,Int) -> (Int,Int) -> (Int,Int) -> 
-                     (HIplImage MonoChromatic Float NoROI, 
-                      HIplImage MonoChromatic Float NoROI)
+                     (HIplImage Monochromatic Float NoROI, 
+                      HIplImage Monochromatic Float NoROI)
 calcOpticalFlowBM prev curr blockSize shiftSize maxRange = 
     unsafePerformIO $
     do velX <- mkHIplImage w h 
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/AI/CV/OpenCV/PixelUtils.hs
index ea1b71d..d60577c 100644
--- a/src/AI/CV/OpenCV/PixelUtils.hs
+++ b/src/AI/CV/OpenCV/PixelUtils.hs
@@ -47,7 +47,7 @@ packPixels img =
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
 isolateChannel :: HasDepth d => 
-                  Int -> HIplImage TriChromatic d NoROI -> V.Vector d
+                  Int -> HIplImage Trichromatic d NoROI -> V.Vector d
 isolateChannel ch img = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 9ab5c30..4b3212b 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -39,29 +39,29 @@ foreign import ccall "opencv2/imgproc/imgproc_c.h cvThreshold"
 
 {-
 class ByteOrFloat a => Thresholdable r a b where
-  doThreshold :: (ImgBuilder r, InplaceROI r a MonoChromatic b MonoChromatic) => 
+  doThreshold :: (ImgBuilder r, Inplace r a Monochromatic b Monochromatic) => 
                  a -> a -> Int -> 
-                 HIplImage MonoChromatic a r -> 
-                 HIplImage MonoChromatic b r
+                 HIplImage Monochromatic a r -> 
+                 HIplImage Monochromatic b r
 
-instance InplaceROI r MonoChromatic Word8 MonoChromatic Word8 =>
+instance Inplace r Monochromatic Word8 Monochromatic Word8 =>
          Thresholdable r Word8 Word8 where
   doThreshold = cvThreshold1
   {-# INLINE doThreshold #-}
 
-instance InplaceROI r MonoChromatic Float MonoChromatic Float =>
+instance Inplace r Monochromatic Float Monochromatic Float =>
          Thresholdable r Float Float where
   doThreshold = cvThreshold1
   {-# INLINE doThreshold #-}
 
-instance InplaceROI r MonoChromatic Float MonoChromatic Word8 =>
+instance Inplace r Monochromatic Float Monochromatic Word8 =>
          Thresholdable r Float Word8 where
   doThreshold = cvThreshold2
   {-# INLINE doThreshold #-}
 
-cvThreshold1 :: (ByteOrFloat a, ImgBuilder r, InplaceROI r M a M a) => 
+cvThreshold1 :: (ByteOrFloat a, ImgBuilder r, Inplace r M a M a) => 
                 a -> a -> Int -> 
-                HIplImage MonoChromatic a r -> HIplImage MonoChromatic a r
+                HIplImage Monochromatic a r -> HIplImage Monochromatic a r
 cvThreshold1 threshold maxValue tType =
   cv $ \src -> void $ c_cvThreshold src src threshold' maxValue' tType'
   where threshold' = realToFrac . toDouble $ threshold
@@ -71,9 +71,9 @@ cvThreshold1 threshold maxValue tType =
 -}
 
 -- The worker function that calls c_cvThreshold.
-cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2, InplaceROI r M d1 M d2) =>
-                d1 -> d1 -> Int -> HIplImage MonoChromatic d1 r ->
-                HIplImage MonoChromatic d2 r
+cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
+                d1 -> d1 -> Int -> HIplImage Monochromatic d1 r ->
+                HIplImage Monochromatic d2 r
 cvThreshold2 threshold maxValue tType = 
     cv2 $ \src dst ->
         do _r <- c_cvThreshold src dst threshold' maxValue' tType'
@@ -85,34 +85,34 @@ cvThreshold2 threshold maxValue tType =
 {-# INLINE cvThreshold2 #-}
 
 -- cvThreshold :: (Thresholdable d1 d2, ImgBuilder r) => d1 -> d1 -> Int -> 
---                HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+--                HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 -- cvThreshold = doThreshold
-cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2, InplaceROI r M d1 M d2) =>
+cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
                d1 -> d1 -> Int -> 
-               HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+               HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 cvThreshold = cvThreshold2
 
 {-# INLINE cvThreshold #-}
 
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
-cvThresholdOtsu :: InplaceROI r M Word8 M Word8 =>
-                   Word8 -> Int -> HIplImage MonoChromatic Word8 r ->
-                   HIplImage MonoChromatic Word8 r
+cvThresholdOtsu :: Inplace r M Word8 M Word8 =>
+                   Word8 -> Int -> HIplImage Monochromatic Word8 r ->
+                   HIplImage Monochromatic Word8 r
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
 {-# INLINE cvThresholdOtsu #-}
 
-type M = MonoChromatic
+type M = Monochromatic
 
 -- |Binary thresholding. Parameters are the @threshold@ value, the
 -- @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
-thresholdBinary :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+thresholdBinary :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                    d1 -> d1 -> 
-                   HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+                   HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
@@ -120,9 +120,9 @@ thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
 -- the @maxValue@ passing pixels are mapped to, and the source
 -- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
-thresholdBinaryInv :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
+thresholdBinaryInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                       d1 -> d1 -> 
-                      HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+                      HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
@@ -131,24 +131,24 @@ thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
 -- @threshold@ value and the source 'HIplImage'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
-thresholdTruncate :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
-                     d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+thresholdTruncate :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
+                     d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
 -- and the source 'HIplImage'.
-thresholdToZero :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
-                   d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+thresholdToZero :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
+                   d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
 -- source 'HIplImage'.
-thresholdToZeroInv :: (SameOrByte d1 d2, ByteOrFloat d1, InplaceROI r M d1 M d2) => 
-                      d1 -> HIplImage MonoChromatic d1 r -> HIplImage MonoChromatic d2 r
+thresholdToZeroInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
+                      d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdToZeroInv threshold = cvThreshold threshold 0 tType
     where tType = fromEnum ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
@@ -157,9 +157,9 @@ thresholdToZeroInv threshold = cvThreshold threshold 0 tType
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'.
-thresholdBinaryOtsu :: (InplaceROI r M Word8 M Word8) =>
-                       Word8 -> HIplImage MonoChromatic Word8 r ->
-                       HIplImage MonoChromatic Word8 r
+thresholdBinaryOtsu :: (Inplace r M Word8 M Word8) =>
+                       Word8 -> HIplImage Monochromatic Word8 r ->
+                       HIplImage Monochromatic Word8 r
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinary
 {-# INLINE thresholdBinaryOtsu #-}
@@ -169,9 +169,9 @@ thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
 -- the threshold with and the source 'HIplImage'. The sense of the
 -- thresholding operation is inverted, as in 'thresholdBinaryInv'.
-thresholdBinaryOtsuInv :: (InplaceROI r M Word8 M Word8) =>
-                          Word8 -> HIplImage MonoChromatic Word8 r ->
-                          HIplImage MonoChromatic Word8 r
+thresholdBinaryOtsuInv :: (Inplace r M Word8 M Word8) =>
+                          Word8 -> HIplImage Monochromatic Word8 r ->
+                          HIplImage Monochromatic Word8 r
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnum ThreshBinaryInv
 {-# INLINE thresholdBinaryOtsuInv #-}
@@ -180,26 +180,26 @@ thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
 -- value; leaves all other pixels unchanged. Takes the source
 -- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
 -- and returned along with the thresholded image.
-thresholdTruncateOtsu :: (InplaceROI r M Word8 M Word8) =>
-                         HIplImage MonoChromatic Word8 r -> 
-                         HIplImage MonoChromatic Word8 r
+thresholdTruncateOtsu :: (Inplace r M Word8 M Word8) =>
+                         HIplImage Monochromatic Word8 r -> 
+                         HIplImage Monochromatic Word8 r
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
 {-# INLINE thresholdTruncateOtsu #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchaged.The @threshold@ value is chosen
 -- using Otsu's method and returned along with the thresholded image.
-thresholdToZeroOtsu :: (InplaceROI r M Word8 M Word8) =>
-                       HIplImage MonoChromatic Word8 r -> 
-                       HIplImage MonoChromatic Word8 r
+thresholdToZeroOtsu :: (Inplace r M Word8 M Word8) =>
+                       HIplImage Monochromatic Word8 r -> 
+                       HIplImage Monochromatic Word8 r
 thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
 {-# INLINE thresholdToZeroOtsu #-}
 
 -- |Maps pixels that are greather than @threshold@ to zero; leaves all
 -- other pixels unchaged.The @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
-thresholdToZeroOtsuInv :: (InplaceROI r M Word8 M Word8) =>
-                          HIplImage MonoChromatic Word8 r -> 
-                          HIplImage MonoChromatic Word8 r
+thresholdToZeroOtsuInv :: (Inplace r M Word8 M Word8) =>
+                          HIplImage Monochromatic Word8 r -> 
+                          HIplImage Monochromatic Word8 r
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
 {-# INLINE thresholdToZeroOtsuInv #-}
diff --git a/src/Examples/VideoFunhouse/Makefile b/src/Examples/VideoFunhouse/Makefile
index fc38dbf..811572e 100644
--- a/src/Examples/VideoFunhouse/Makefile
+++ b/src/Examples/VideoFunhouse/Makefile
@@ -1,2 +1,2 @@
 all:	VideoFunhouse.hs Rate.hs
-	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=15 -with-rtsopts="-A4M"
+	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=18 -with-rtsopts="-A4M"
diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index 22c9652..4f79c06 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -50,7 +50,6 @@ boostSat x = convertHSVToBGR $ replaceChannel 1 s' hsv
 centralFocus :: ColorImage -> ColorImage
 centralFocus img = withROI r (copy (setROI r img)) bg
   where bg = smoothGaussian 35 . boostSat $ img
-        white = cvOrS (255,255,255) img
         r = CvRect 150 100 340 280
 {-# INLINE centralFocus #-}
 

From 3a781e01bc0ab6322d5204d9ac5377bcc874250f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 22 Jul 2011 17:04:50 -0400
Subject: [PATCH 108/137] Added support for Int16 images and Sobel filtering.

---
 src/AI/CV/OpenCV/ArrayOps.hs        | 47 +++++++++++++++++++---
 src/AI/CV/OpenCV/Core/CVOp.hs       | 21 +++++++++-
 src/AI/CV/OpenCV/Core/HIplImage.hsc | 14 ++++++-
 src/AI/CV/OpenCV/Core/HIplUtil.hs   |  9 ++++-
 src/AI/CV/OpenCV/Filtering.hsc      | 62 ++++++++++++++++++++++++++++-
 src/AI/CV/OpenCV/HighCV.hs          |  2 +-
 6 files changed, 141 insertions(+), 14 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hs
index 28e4ed3..91d2338 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables,
              FlexibleContexts #-}
 -- |Array operations.
-module AI.CV.OpenCV.ArrayOps (subRS, absDiff, convertScale, 
+module AI.CV.OpenCV.ArrayOps (subRS, absDiff, abs, convertScale, 
                               cvAnd, andMask, scaleAdd, cvAndS,
-                              cvOr, cvOrS, set, 
+                              cvOr, cvOrS, set, cvAbs, cvAbsDiffS,
                               mul, mulS, add, addS, sub, subMask,
                               cmpS, avg, avgMask, cvNot, withROI,
                               ComparisonOp(..), isolateChannel, copy,
-                              replaceChannel) where
+                              replaceChannel, convertScaleAbs, absSat) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
@@ -45,6 +45,24 @@ absDiff src1 = cv2 $ \src2 dst ->
                  c_cvAbsDiff (castPtr src1') src2 dst
 {-# INLINE absDiff #-}
 
+foreign import ccall "opencv2/core/core_c.h cvAbsDiffS"
+  c_cvAbsDiffS :: Ptr CvArr -> Ptr CvArr -> 
+                  CDouble -> CDouble -> CDouble -> CDouble -> IO ()
+
+-- |Absolute difference of each pixel in an image and a scalar.
+cvAbsDiffS :: (HasChannels c, HasDepth d, Inplace r c d c d,
+               IsCvScalar s, s ~ CvScalar c d) =>
+              s -> HIplImage c d r -> HIplImage c d r
+cvAbsDiffS value = cv2 $ \src dst -> c_cvAbsDiffS src dst r g b a
+  where (r,g,b,a) = toCvScalar value
+{-# INLINE cvAbsDiffS #-}
+
+-- |Absolute value of each pixel.
+cvAbs :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
+         HIplImage c d r -> HIplImage c d r
+cvAbs = cv2 $ \src dst -> c_cvAbsDiffS src dst 0 0 0 0
+{-# INLINE cvAbs #-}
+
 foreign import ccall "opencv2/core/core_c.h cvConvertScale"
   c_cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
 
@@ -64,6 +82,24 @@ convertScale scale shift = cv2 $ \src dst ->
   where rf = realToFrac
 {-# INLINE convertScale #-}
 
+foreign import ccall "opencv2/core/core_c.h cvConvertScaleAbs"
+  c_cvConvertScaleAbs :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()
+
+-- |@convertScaleAbs scale shift@ scales each element of an image,
+-- adds an offset to the scaled value, computes the absolute value,
+-- and saturates to 8 bits.
+convertScaleAbs :: (HasChannels c, HasDepth d, Inplace r c d c Word8) =>
+                   CDouble -> CDouble -> HIplImage c d r -> HIplImage c Word8 r
+convertScaleAbs scale shift = cv2 $ \src dst -> 
+                              c_cvConvertScaleAbs src dst scale shift
+{-# INLINE convertScaleAbs #-}
+
+-- |Computes the absolute value of each pixel and saturates to 8 bits.
+absSat :: (HasChannels c, HasDepth d, Inplace r c d c Word8) =>
+          HIplImage c d r -> HIplImage c Word8 r
+absSat = convertScaleAbs 1 0
+{-# INLINE absSat #-}
+
 foreign import ccall "opencv2/core/core_c.h cvAnd"
   c_cvAnd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
@@ -144,8 +180,9 @@ foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum.
-add :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
-       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+add :: (HasChannels c, HasDepth d1, HasDepth d2, HasDepth d3,
+        ImgBuilder r1, Inplace r2 c d2 c d3) => 
+       HIplImage c d1 r1 -> HIplImage c d2 r2 -> HIplImage c d3 r2
 add src1 = cv2 $ \src2 dst ->
            withHIplImage src1 $ \src1' ->
                c_cvAdd (castPtr src1') src2 dst nullPtr
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index ad493bb..260112c 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -23,6 +23,7 @@ import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.HIplImage
 import Control.Monad ((>=>), void)
+import Data.Int
 import Data.Monoid
 import Foreign.ForeignPtr
 import Foreign.Ptr
@@ -148,12 +149,21 @@ instance (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
 
 -- If the source and destination are not compatible, then it doesn't
 -- matter if there is a ROI set as we can never operate in-place.
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Word8 c2 Int16 where
+
 instance (HasChannels c1, HasChannels c2) => 
          Inplace HasROI c1 Float c2 Word16 where
 
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Float c2 Int16 where
+
 instance (HasChannels c1, HasChannels c2) => 
          Inplace HasROI c1 Float c2 Double where
 
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Word16 c2 Int16 where
+
 instance (HasChannels c1, HasChannels c2) => 
          Inplace HasROI c1 Word16 c2 Float where
 
@@ -169,11 +179,18 @@ instance (HasChannels c1, HasChannels c2) =>
 instance (HasChannels c1, HasChannels c2) => 
          Inplace HasROI c1 Double c2 Word8 where
 
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Double c2 Int16 where
 
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Int16 c2 Word8 where
 
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Int16 c2 Word16 where
 
-
-
+-- |This can be in-place due to the common representation.
+instance (HasChannels c1, HasChannels c2) => 
+         Inplace HasROI c1 Int16 c2 Float where
 
 newtype BinOp a b = 
     BinOp { binop :: Ptr CvArr -> Ptr CvArr -> IO () }
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index c162969..9c2feac 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -18,13 +18,15 @@ module AI.CV.OpenCV.Core.HIplImage (
     c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
     widthStep, imageDataOrigin, setROI, resetROI, ImgBuilder(..)
   ) where
-import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u,
-                                 iplDepth32f, iplDepth64f, cvFree, CvRect(..))
+import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
+                                 iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
+                                 CvRect(..))
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
 import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (complement, (.&.))
+import Data.Int
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
@@ -106,6 +108,10 @@ instance HasDepth Word16 where
     depth _ = iplDepth16u
     toDouble = fromIntegral
     fromDouble = round
+instance HasDepth Int16 where 
+    depth _ = iplDepth16s
+    toDouble = fromIntegral
+    fromDouble = round
 instance HasDepth Float where 
     depth _ = iplDepth32f
     toDouble = realToFrac
@@ -143,6 +149,10 @@ instance IsCvScalar Word16 where
     toCvScalar = depthToScalar
     fromCvScalar (r,_,_,_) = floor r
 
+instance IsCvScalar Int16 where
+    toCvScalar = depthToScalar
+    fromCvScalar (r,_,_,_) = floor r
+
 instance IsCvScalar Float where
     toCvScalar = depthToScalar
     fromCvScalar (r,_,_,_) = realToFrac r
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index 7ba5678..f95f91f 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -9,7 +9,8 @@ module AI.CV.OpenCV.Core.HIplUtil
      withDuplicateImage, withCompatibleImage, setROI, resetROI,
      mkHIplImage, width, height, mkBlackImage, HIplImage, NoROI, HasROI,
      withHIplImage, Monochromatic, Trichromatic, HasChannels, ImgBuilder(..),
-     GrayImage, GrayImage16, ColorImage, c_cvSetImageROI, c_cvResetImageROI,
+     GrayImage, GrayImage16, GrayImage16S, ColorImage, 
+     c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
@@ -21,6 +22,7 @@ import AI.CV.OpenCV.Core.HIplImage
 import Control.Applicative
 import Control.Arrow (second, (***))
 import Control.Monad (when, unless, join)
+import Data.Int (Int16)
 import qualified Data.Vector.Storable as V
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -40,9 +42,12 @@ instance ByteOrFloat Float where
 -- |Grayscale 8-bit (per-pixel) image type.
 type GrayImage = HIplImage Monochromatic Word8 NoROI
 
--- |Grayscale 16-bit (per-pixel) image type.
+-- |Grayscale unsigned 16-bit (per-pixel) image type.
 type GrayImage16 = HIplImage Monochromatic Word16 NoROI
 
+-- |Grayscale signed 16-bit (per-pixel) image type.
+type GrayImage16S = HIplImage Monochromatic Int16 NoROI
+
 -- |Color 8-bit (per-color) image type.
 type ColorImage = HIplImage Trichromatic Word8 NoROI
 
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index 50a0cd2..fe09149 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -1,6 +1,10 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}
 -- |Image filtering operations.
-module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian') where
+module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian', 
+                               sobel, sobelDX, sobelDY,
+                               ApertureSize(..), DerivativeOrder(..)) where
+import Data.Word (Word8)
+import Data.Int (Int16)
 import Foreign.C.Types (CInt, CDouble)
 import Foreign.Ptr (Ptr, castPtr)
 import AI.CV.OpenCV.Core.CxCore
@@ -50,3 +54,57 @@ smoothGaussian' w h sigma =
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
           h' = case h of { Nothing -> 0; Just jh -> jh }
 {-# INLINE smoothGaussian' #-}
+
+foreign import ccall "opencv2/imgproc/imgproc_c.h cvSobel"
+  cvSobel :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CInt -> IO ()
+
+-- |Size of the extended Sobel kernel. When 'ApertureOne' is used, a
+-- 3x1 or 1x3 kernel is used with no Gaussian smoothing. Note that
+-- 'ApertureOne' can only be used for the first or second x or y
+-- derivatives.
+data ApertureSize = ApertureOne | ApertureThree | ApertureFive | ApertureSeven
+
+-- |Order of the derivative computed using a Sobel operator.
+data DerivativeOrder = OrderZero | OrderOne | OrderTwo | OrderThree
+
+apertureToInt :: ApertureSize -> CInt
+apertureToInt ApertureOne   = 1
+apertureToInt ApertureThree = 3
+apertureToInt ApertureFive  = 5
+apertureToInt ApertureSeven = 7
+
+orderToInt :: DerivativeOrder -> CInt
+orderToInt OrderZero  = 0
+orderToInt OrderOne   = 1
+orderToInt OrderTwo   = 2
+orderToInt OrderThree = 3
+
+type family SobelDest a :: *
+type instance SobelDest Word8 = Int16
+type instance SobelDest Float = Float
+
+-- |Calculates the first, second, third or mixed image derivatives
+-- using an extended Sobel operators. @sobel xOrder yOrder apertureSize img@
+sobel :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, 
+          HasChannels c, Inplace r c d1 c d2) =>
+         DerivativeOrder -> DerivativeOrder -> ApertureSize -> 
+         HIplImage c d1 r -> HIplImage c d2 r
+sobel xOrder yOrder apertureSize = cv2 $ \src dst -> cvSobel src dst x y ap
+  where ap = apertureToInt apertureSize
+        x = orderToInt xOrder
+        y = orderToInt yOrder
+{-# INLINE sobel #-}
+
+-- |Compute the first X derivative of an image using a Sobel operator.
+sobelDX :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, 
+            HasChannels c, Inplace r c d1 c d2) =>
+           ApertureSize -> HIplImage c d1 r -> HIplImage c d2 r
+sobelDX = sobel OrderOne OrderZero
+{-# INLINE sobelDX #-}
+
+-- |Compute the first Y derivative of an image using a Sobel operator.
+sobelDY :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1,
+            HasChannels c, Inplace r c d1 c d2) =>
+            ApertureSize -> HIplImage c d1 r -> HIplImage c d2 r
+sobelDY = sobel OrderZero OrderOne
+{-# INLINE sobelDY #-}
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 7ce6d56..22531a4 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -33,7 +33,7 @@ module AI.CV.OpenCV.HighCV (
                             -- * Image types
                             HIplImage, Monochromatic, Trichromatic, 
                             HasChannels, HasDepth, 
-                            GrayImage, ColorImage, GrayImage16, 
+                            GrayImage, ColorImage, GrayImage16, GrayImage16S,
                             Word8, Word16
     ) where
 import AI.CV.OpenCV.Core.CxCore

From 4bf18852e4fb5bcf8de1d0d83c565eb02424c767 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Fri, 29 Jul 2011 11:05:53 -0400
Subject: [PATCH 109/137] Added libopencv_video to extra-libraries.

---
 HOpenCV.cabal | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index ff7d824..db505c5 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -64,13 +64,13 @@ library
    if os(windows)
      include-dirs:	C:\\OpenCV2.2\\include
      extra-lib-dirs:	C:\\OpenCV2.2\\bin
-     extra-libraries: 	opencv_core220,opencv_imgproc220,opencv_highgui220
+     extra-libraries: 	opencv_core220,opencv_imgproc220,opencv_highgui220,opencv_video220
    else
      if flag(OpenCV21)
        CC-Options:      "-DOCV21"
        extra-libraries: cv highgui
      else
-       extra-libraries: opencv_core,opencv_imgproc,opencv_highgui
+       extra-libraries: opencv_core,opencv_imgproc,opencv_highgui,opencv_video
    build-depends: base >=4 && <5, 
                   template-haskell,
                   allocated-processor >= 0.0.1, 

From 90e674713380c9912bd26fa964930ed5b3112cb3 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Wed, 10 Aug 2011 18:12:12 -0400
Subject: [PATCH 110/137] Added fillConvexPoly

---
 src/AI/CV/OpenCV/Core/CxCore.hsc |  3 +++
 src/AI/CV/OpenCV/Drawing.hs      | 18 +++++++++++++++++-
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 622ab92..217b219 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -320,6 +320,9 @@ cvLine dst (x1,y1) (x2,y2) (r,g,b) thickness lineType =
         where fi = fromIntegral
               fr = realToFrac
 
+foreign import ccall "opencv2/core/core_c.h cvFillConvexPoly"
+  c_cvFillConvexPoly :: Ptr CvArr -> Ptr CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> CInt -> CInt -> IO ()
+
 data CvFont
 instance Storable CvFont where
   sizeOf _ = (#size CvFont)
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hs
index 6577fcd..5562162 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hs
@@ -1,5 +1,5 @@
 module AI.CV.OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
-                             LineType(..), RGB, drawLines) where
+                             LineType(..), RGB, drawLines, fillConvexPoly) where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
@@ -7,6 +7,7 @@ import Data.Bits ((.|.))
 import Foreign.C.String
 import Foreign.C.Types
 import Foreign.Marshal.Alloc (malloc)
+import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr
 import System.IO.Unsafe (unsafePerformIO)
 
@@ -105,3 +106,18 @@ drawLines col thick lineType lines =
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
           lineType' = lineTypeEnum lineType
 {-# INLINE drawLines #-}
+
+-- |Draw a filled, convex polygon. Can draw all monotonic polygons
+-- without self-intersections including those with horizontal top or
+-- bottom edges.
+fillConvexPoly :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+                  RGB -> LineType -> [(Int,Int)] -> 
+                  HIplImage c d r -> HIplImage c d r
+fillConvexPoly (r,g,b) lineType pts = 
+  cv $ \img -> withArray (concatMap flatten pts) $ \pts' ->
+               c_cvFillConvexPoly img pts' (fi $ length pts) 
+                                  (fr r) (fr g) (fr b) 0 lt 0
+  where lt = fi $ lineTypeEnum lineType
+        flatten (x,y) = [fi x, fi y]
+        fi = fromIntegral
+        fr = realToFrac
\ No newline at end of file

From 680f999bdf3e3be948dd43e84973d1730cb26ae0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@seas.upenn.edu>
Date: Sat, 20 Aug 2011 11:53:31 -0400
Subject: [PATCH 111/137] Added a flag to control the export of optical flow
 bindings. These bindings, if present, prevent GHCi from linking with HOpenCV
 so the flag defaults to False (no bindings).

---
 HOpenCV.cabal | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index db505c5..a6aabc8 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,5 +1,5 @@
 name: HOpenCV
-version: 0.2
+version: 0.2.1
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
@@ -8,7 +8,7 @@ category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
 Tested-With:   GHC==7.0.3
 description:
-   Limited bindings to OpenCV 2.2. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
+   Limited bindings to OpenCV 2.3. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
    /Installation/
    .
@@ -34,6 +34,10 @@ Flag OpenCV21
   Description: Link against OpenCV 2.1
   Default:     False
 
+Flag MotionAnalysis
+  Description: Export optical flow bindings. Doesn't work with GHCi.
+  Default:     False
+
 library
    exposed-modules:
       AI.CV.OpenCV.Core.CV
@@ -50,7 +54,6 @@ library
       AI.CV.OpenCV.PixelUtils
       AI.CV.OpenCV.ColorConversion
       AI.CV.OpenCV.Drawing
-      AI.CV.OpenCV.Motion
       AI.CV.OpenCV.Contours
       AI.CV.OpenCV.Threshold
       AI.CV.OpenCV.ArrayOps
@@ -61,6 +64,8 @@ library
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
    other-modules: 
    hs-Source-Dirs: src
+   if flag(MotionAnalysis)
+     exposed-modules:   AI.CV.OpenCV.Motion
    if os(windows)
      include-dirs:	C:\\OpenCV2.2\\include
      extra-lib-dirs:	C:\\OpenCV2.2\\bin

From c134f3c24277b6a848a659386179b8daf00ac077 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@tremolo>
Date: Tue, 3 Jan 2012 14:25:27 -0500
Subject: [PATCH 112/137] Fixed several FFI bugs exposed on 64bit builds.

Several unsafe approaches to passing structs by value have been fixed using more extensive hsc2hs wrapping.
---
 .gitignore                                    |   5 +
 HOpenCV.cabal                                 |  11 +-
 Setup.hs                                      |  20 +++
 .../CV/OpenCV/{ArrayOps.hs => ArrayOps.hsc}   | 168 ++++++++++++------
 src/AI/CV/OpenCV/Core/CVOp.hs                 |   4 +-
 src/AI/CV/OpenCV/Core/CxCore.hsc              |  40 +++++
 src/AI/CV/OpenCV/Core/HIplImage.hsc           |  32 ++--
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.c          |  12 +-
 src/AI/CV/OpenCV/Core/HOpenCV_wrap.h          |   2 +-
 src/AI/CV/OpenCV/Core/HighGui.hsc             |   5 +
 src/AI/CV/OpenCV/{Drawing.hs => Drawing.hsc}  |  27 ++-
 src/AI/CV/OpenCV/FloodFill.hsc                |  40 +++--
 src/AI/CV/OpenCV/Threshold.hs                 |  33 ++--
 src/Examples/VideoFunhouse/Makefile           |   3 +
 14 files changed, 284 insertions(+), 118 deletions(-)
 create mode 100644 Setup.hs
 rename src/AI/CV/OpenCV/{ArrayOps.hs => ArrayOps.hsc} (72%)
 rename src/AI/CV/OpenCV/{Drawing.hs => Drawing.hsc} (81%)

diff --git a/.gitignore b/.gitignore
index 1521c8b..38b28b8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,6 @@
 dist
+*_hsc.c
+*_hsc.h
+*.hi
+*.o
+
diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index a6aabc8..33f7d9e 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -19,8 +19,8 @@ description:
    The "AI.CV.OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations. While the @Core@ modules contain to low-level OpenCV interfaces.
    .
    See @src\/Examples\/VideoFunhouse@ for an example application.
-build-type:         Simple
-cabal-version:      >= 1.2
+build-type:         Custom
+cabal-version:      >= 1.8
 extra-source-files: src/AI/CV/OpenCV/Core/HOpenCV_wrap.h 
                     src/Examples/VideoFunhouse/Makefile 
                     src/Examples/VideoFunhouse/Rate.hs
@@ -62,7 +62,10 @@ library
       AI.CV.OpenCV.Histograms
    c-sources:
       src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-   other-modules: 
+      src/AI/CV/OpenCV/ArrayOps_hsc.c
+      src/AI/CV/OpenCV/FloodFill_hsc.c
+      src/AI/CV/OpenCV/Drawing_hsc.c
+   other-modules: AI.CV.OpenCV.Core.StorableUtil
    hs-Source-Dirs: src
    if flag(MotionAnalysis)
      exposed-modules:   AI.CV.OpenCV.Motion
@@ -81,5 +84,5 @@ library
                   allocated-processor >= 0.0.1, 
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
-                  vector == 0.7.*
+                  vector >= 0.7
    ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -O2 -funbox-strict-fields
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..6516886
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,20 @@
+import Data.List (intercalate)
+import Distribution.Simple
+import System.Cmd
+import System.Exit
+import System.FilePath
+
+libs :: [String]
+libs = ["opencv_core", "opencv_imgproc", "opencv_highgui", "opencv_video"]
+
+runHsc2hs :: FilePath -> IO ExitCode
+runHsc2hs f = system $ "hsc2hs "++f++" "++libs'
+  where libs' = intercalate " " $ map ("-L -l"++) libs
+
+srcPath :: FilePath
+srcPath = "src/AI/CV/OpenCV"
+
+main :: IO ()
+main = do mapM_ (runHsc2hs . (srcPath </>) . flip addExtension "hsc")
+                ["ArrayOps", "FloodFill", "Drawing"]
+          defaultMain
diff --git a/src/AI/CV/OpenCV/ArrayOps.hs b/src/AI/CV/OpenCV/ArrayOps.hsc
similarity index 72%
rename from src/AI/CV/OpenCV/ArrayOps.hs
rename to src/AI/CV/OpenCV/ArrayOps.hsc
index 91d2338..e44e1ea 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hs
+++ b/src/AI/CV/OpenCV/ArrayOps.hsc
@@ -13,25 +13,34 @@ import Foreign.C.Types (CDouble, CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc
-import Foreign.Storable (poke)
+import Foreign.Storable (poke, peek)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), 
+import AI.CV.OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), CvScalar(..),
                                  cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
+import AI.CV.OpenCV.Core.StorableUtil
 
 type M = Monochromatic
 
-foreign import ccall "opencv2/core/core_c.h cvSubRS"
-  c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+#include <opencv2/core/core_c.h>
+
+#def void c_cvSubRS(CvArr* src1, CvScalar* src2, CvArr* dst, const CvArr* mask) { cvSubRS(src1, *src2, dst, mask); }
+
+-- foreign import ccall "opencv2/core/core_c.h cvSubRS"
+--   c_cvSubRS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--                Ptr CvArr -> Ptr CvArr -> IO ()
+foreign import ccall "" -- "static ArrayOps_hsc.h c_cvSubRS"
+  c_cvSubRS :: Ptr CvArr -> Ptr CvScalar -> 
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |@subRS value src@ computes @value - src[i]@ for every pixel.
 subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
-          IsCvScalar s, s ~ CvScalar c d, Inplace r c d c d) =>
+          IsCvScalar s, s ~ CvScalarT c d, Inplace r c d c d) =>
          s -> HIplImage c d r -> HIplImage c d r
-subRS value = cv2 $ \src dst -> c_cvSubRS src r g b a dst nullPtr
-    where (r,g,b,a) = toCvScalar value
+subRS value = cv2 $ \src dst -> 
+              withS (toCvScalar value) $ \sPtr ->
+                c_cvSubRS src sPtr dst nullPtr
 {-# INLINE subRS #-}
 
 foreign import ccall "opencv2/core/core_c.h cvAbsDiff"
@@ -45,22 +54,31 @@ absDiff src1 = cv2 $ \src2 dst ->
                  c_cvAbsDiff (castPtr src1') src2 dst
 {-# INLINE absDiff #-}
 
-foreign import ccall "opencv2/core/core_c.h cvAbsDiffS"
-  c_cvAbsDiffS :: Ptr CvArr -> Ptr CvArr -> 
-                  CDouble -> CDouble -> CDouble -> CDouble -> IO ()
+#def void c_cvAbsDiffS(const CvArr* src, CvArr* dst, CvScalar* value) {\
+  cvAbsDiffS(src, dst, *value);\
+}
+
+-- foreign import ccall "opencv2/core/core_c.h cvAbsDiffS"
+--   c_cvAbsDiffS :: Ptr CvArr -> Ptr CvArr -> 
+--                   CDouble -> CDouble -> CDouble -> CDouble -> IO ()
+foreign import ccall ""
+  c_cvAbsDiffS :: Ptr CvArr -> Ptr CvArr -> Ptr CvScalar -> IO ()
 
 -- |Absolute difference of each pixel in an image and a scalar.
 cvAbsDiffS :: (HasChannels c, HasDepth d, Inplace r c d c d,
-               IsCvScalar s, s ~ CvScalar c d) =>
+               IsCvScalar s, s ~ CvScalarT c d) =>
               s -> HIplImage c d r -> HIplImage c d r
-cvAbsDiffS value = cv2 $ \src dst -> c_cvAbsDiffS src dst r g b a
-  where (r,g,b,a) = toCvScalar value
+cvAbsDiffS value = cv2 $ \src dst -> 
+                   withS (toCvScalar value) $ \vPtr ->
+                     c_cvAbsDiffS src dst vPtr
 {-# INLINE cvAbsDiffS #-}
 
 -- |Absolute value of each pixel.
 cvAbs :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
          HIplImage c d r -> HIplImage c d r
-cvAbs = cv2 $ \src dst -> c_cvAbsDiffS src dst 0 0 0 0
+cvAbs = cv2 $ \src dst -> 
+        withS (CvScalar 0 0 0 0) $ \sPtr -> 
+          c_cvAbsDiffS src dst sPtr
 {-# INLINE cvAbs #-}
 
 foreign import ccall "opencv2/core/core_c.h cvConvertScale"
@@ -125,32 +143,46 @@ cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' ->
              c_cvAnd (castPtr src1') src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
-foreign import ccall "opencv2/core/core_c.h cvAndS"
-   c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
-               Ptr CvArr -> Ptr CvArr -> IO ()
+#def void c_cvAndS(const CvArr* src, CvScalar* value, CvArr* dst, const CvArr* mask) { cvAndS(src, *value, dst, mask); }
+
+-- foreign import ccall "opencv2/core/core_c.h cvAndS"
+--    c_cvAndS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--                Ptr CvArr -> Ptr CvArr -> IO ()
+foreign import ccall ""
+   c_cvAndS :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> Ptr CvArr -> IO ()
+
 
 -- |Per-element bit-wise conjunction of an array and a scalar. 
 cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
-           s ~ CvScalar c d, Inplace r c d c d) => 
+           s ~ CvScalarT c d, Inplace r c d c d) => 
           s -> HIplImage c d r -> HIplImage c d r
-cvAndS s = cv2 $ \img dst -> c_cvAndS img r g b a dst nullPtr
-    where (r,g,b,a) = toCvScalar s
+cvAndS s = cv2 $ \img dst -> 
+           withS (toCvScalar s) $ \sPtr ->
+             c_cvAndS img sPtr dst nullPtr
 {-# INLINE cvAndS #-}
 
-foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
-  c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
-                  Ptr CvArr -> Ptr CvArr -> IO ()
+#def void c_cvScaleAdd(const CvArr* src1, CvScalar* scale,\
+                       const CvArr* src2, CvArr* dst) {\
+  cvScaleAdd(src1, *scale, src2, dst);\
+}
+
+-- foreign import ccall "opencv2/core/core_c.h cvScaleAdd"
+--   c_cvScaleAdd :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--                   Ptr CvArr -> Ptr CvArr -> IO ()
+foreign import ccall ""
+  c_cvScaleAdd :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> Ptr CvArr -> IO ()
+
 
 -- |Calculate the sum of a scaled array and another array. @scaleAdd
 -- src1 s src2@ computes @dst[i] = s*src1[i] + src2[i]@
 scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
-             s ~ CvScalar c d, IsCvScalar s, ImgBuilder r1, 
+             s ~ CvScalarT c d, IsCvScalar s, ImgBuilder r1, 
              Inplace r2 c d c d) => 
             HIplImage c d r1 -> s -> HIplImage c d r2 -> HIplImage c d r2
 scaleAdd src1 s = cv2 $ \src2 dst ->
                   withHIplImage src1 $ \src1' ->
-                      c_cvScaleAdd (castPtr src1') r g b a src2 dst
-    where (r,g,b,a) = toCvScalar s
+                  withS (toCvScalar s) $ \sPtr ->
+                    c_cvScaleAdd (castPtr src1') sPtr src2 dst
 {-# INLINE scaleAdd #-}
 
 foreign import ccall "opencv2/core/core_c.h cvMul"
@@ -188,16 +220,24 @@ add src1 = cv2 $ \src2 dst ->
                c_cvAdd (castPtr src1') src2 dst nullPtr
 {-# INLINE add #-}
 
-foreign import ccall "opencv2/core/core_c.h cvAddS"
-  c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
-              Ptr CvArr -> Ptr CvArr -> IO ()
+#def void c_cvAddS(const CvArr* src, CvScalar* value, CvArr* dst,\
+                   const CvArr* mask) {\
+  cvAddS(src, *value, dst, mask);\
+}
+
+-- foreign import ccall "opencv2/core/core_c.h cvAddS"
+--   c_cvAddS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--               Ptr CvArr -> Ptr CvArr -> IO ()
+foreign import ccall ""
+  c_cvAddS :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Computes the sum of an array and a scalar.
-addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
          Inplace r c d c d) => 
         s -> HIplImage c d r -> HIplImage c d r
-addS scalar = cv2 $ \src dst -> c_cvAddS src r g b a dst nullPtr
-    where (r,g,b,a) = toCvScalar scalar
+addS scalar = cv2 $ \src dst -> 
+              withS (toCvScalar scalar) $ \sPtr ->
+                c_cvAddS src sPtr dst nullPtr
 {-# INLINE addS #-}
 
 foreign import ccall "opencv2/core/core_c.h cvSub"
@@ -236,28 +276,44 @@ cvOr img1 = cv2 $ \img2 dst ->
                 c_cvOr (castPtr img1') img2 dst nullPtr
 {-# INLINE cvOr #-}
 
-foreign import ccall "opencv2/core/core_c.h cvOrS"
-  c_cvOrS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
-             Ptr CvArr -> Ptr CvArr -> IO ()
+#def void c_cvOrS(const CvArr* src, CvScalar* value, CvArr* dst,\
+                  const CvArr* mask) {\
+  cvOrS(src, *value, dst, mask);\
+}
+
+-- foreign import ccall "opencv2/core/core_c.h cvOrS"
+--   c_cvOrS :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--              Ptr CvArr -> Ptr CvArr -> IO ()
+foreign import ccall ""
+  c_cvOrS :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> Ptr CvArr -> IO ()
+
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
-cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
           Inplace r c d c d) => 
          s -> HIplImage c d r -> HIplImage c d r
-cvOrS scalar = cv2 $ \src dst -> c_cvOrS src r g b a dst nullPtr
-    where (r,g,b,a) = toCvScalar scalar
+cvOrS scalar = cv2 $ \src dst -> 
+               withS (toCvScalar scalar) $ \sPtr ->
+                 c_cvOrS src sPtr dst nullPtr
 {-# INLINE cvOrS #-}
 
-foreign import ccall "opencv2/core/core_c.h cvSet"
-  c_cvSet :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
-             Ptr CvArr -> IO ()
+#def void c_cvSet(CvArr* src, CvScalar* value, const CvArr* mask) {\
+  cvSet(src, *value, mask);\
+}
 
--- |Per-element bit-wise disjunction of an array and a scalar.
-set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+-- foreign import ccall "opencv2/core/core_c.h cvSet"
+--   c_cvSet :: Ptr CvArr -> CDouble -> CDouble -> CDouble -> CDouble -> 
+--              Ptr CvArr -> IO ()
+foreign import ccall ""
+  c_cvSet :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> IO ()
+
+-- |Set every element of an array to a given value.
+set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
         Inplace r c d c d) => 
        s -> HIplImage c d r -> HIplImage c d r
-set scalar = cv $ \src -> c_cvSet src r g b a nullPtr
-    where (r,g,b,a) = toCvScalar scalar
+set scalar = cv $ \src -> 
+             withS (toCvScalar scalar) $ \sPtr ->
+               c_cvSet src sPtr nullPtr
 {-# INLINE set #-}
 
 setROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
@@ -302,26 +358,30 @@ cmpS op v = cv2 $ \src dst ->
 {-# INLINE cmpS #-}
 
 foreign import ccall "HOpenCV_wrap.h c_cvAvg"
-  c_cvAvg :: Ptr CvArr -> Ptr CvArr -> Ptr CDouble -> IO ()
+  c_cvAvg :: Ptr CvArr -> Ptr CvArr -> Ptr CvScalar -> IO ()
 
 avgWorker :: IsCvScalar b => Ptr CvArr -> Ptr CvArr -> IO b
-avgWorker img mask = allocaArray 4 $ 
-                     \arr -> do c_cvAvg img mask arr
-                                [r,g,b,a] <- peekArray 4 arr
-                                return $ fromCvScalar (r,g,b,a)
+avgWorker img mask = alloca $ \ptr ->
+                     c_cvAvg img mask ptr >> fromCvScalar `fmap` peek ptr
+-- avgWorker img mask = allocaArray 4 $ 
+--                      \arr -> do c_cvAvg img mask arr
+--                                 fromCvScalar `fmap` peek arr
+--                                 -- [r,g,b,a] <- peekArray 4 arr
+--                                 -- return $ fromCvScalar (r,g,b,a)
 
 -- |Calculates the mean independently for each channel.
-avg :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, ImgBuilder r) => 
-       HIplImage c d r -> CvScalar c d
+avg :: (HasChannels c, HasDepth d, IsCvScalar s, 
+        s ~ CvScalarT c d, ImgBuilder r) => 
+       HIplImage c d r -> CvScalarT c d
 avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr . castPtr
 {-# NOINLINE avg #-}
 
 -- |@avgMask img mask@ calculates the mean independently for each
 -- channel for each element of the source array whose entry in @mask@
 -- is non-zero.
-avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalar c d, 
+avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
             ImgBuilder r1, ImgBuilder r2) => 
-           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> CvScalar c d
+           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> CvScalarT c d
 avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
                    withHIplImage mask $ avgWorker (castPtr src) . castPtr
 {-# NOINLINE avgMask #-}
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index 260112c..3ea3305 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -57,7 +57,7 @@ withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f (castPtr x) >>
 -- |Run a 'CVOp'.
 runCV :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2) => 
          CVOp c d -> HIplImage c d r1 -> HIplImage c d r2
-runCV = (unsafePerformIO .) . withClone . op
+runCV = (unsafeDupablePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
 -- Apply a binary function to the same argument twice.
@@ -211,7 +211,7 @@ withDst f img = do img2' <- mkHIplImage (width img) (height img)
 
 runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) => 
             BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
-runBinOp = (unsafePerformIO .) . withDst . binop
+runBinOp = (unsafeDupablePerformIO .) . withDst . binop
 {-# NOINLINE runBinOp #-}
 
 {-# RULES "runCV/fuse"
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 217b219..0e0c39c 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -1,11 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
 
 module AI.CV.OpenCV.Core.CxCore where
+import Control.Applicative
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.ForeignPtr
 import Foreign.ForeignPtrWrap
 import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
 import Foreign.Ptr
 import Foreign.Storable
 --import System.IO.Unsafe (unsafePerformIO)
@@ -92,6 +94,44 @@ instance VectorSpace CvRect where
   type Scalar CvRect = Double -- todo: use CInt instead of Double here?
   a *^ r = liftCvRect (a*) r
 
+data CvPoint = CvPoint {-# UNPACK #-} !CInt {-# UNPACK #-} !CInt
+
+instance Storable CvPoint where
+  sizeOf _ = (#size CvPoint)
+  alignment _ = alignment (undefined :: CInt)
+  peek ptr = CvPoint <$> (#peek CvPoint, x) ptr 
+                     <*> (#peek CvPoint, y) ptr
+  poke ptr (CvPoint x y) = (#poke CvPoint, x) ptr x >>
+                           (#poke CvPoint, y) ptr y
+
+
+data CvScalar = CvScalar {-# UNPACK #-} !CDouble
+                         {-# UNPACK #-} !CDouble
+                         {-# UNPACK #-} !CDouble
+                         {-# UNPACK #-} !CDouble 
+                deriving Show
+
+instance Storable CvScalar where
+  sizeOf _ = (#size CvScalar)
+  alignment _ = alignment (undefined :: CDouble)
+  peek ptr = do [x,y,z,w] <- peekArray 4 $ (#ptr CvScalar, val) ptr
+                return $ CvScalar x y z w
+  poke ptr (CvScalar x y z w) = pokeArray ((#ptr CvScalar, val) ptr)
+                                          [x,y,z,w]
+
+liftCvScalar :: (CDouble -> CDouble) -> CvScalar -> CvScalar
+liftCvScalar f (CvScalar x y z w) = CvScalar (f x) (f y) (f z) (f w)
+
+instance AdditiveGroup CvScalar where
+  zeroV = CvScalar 0 0 0 0
+  CvScalar x1 y1 z1 w1 ^+^ CvScalar x2 y2 z2 w2 = 
+    CvScalar (x1+x2) (y1+y2) (z1+z2) (w1+w2)
+  negateV = liftCvScalar (0 -)
+
+instance VectorSpace CvScalar where
+  type Scalar CvScalar = CDouble
+  a *^ s = liftCvScalar (a*) s
+
 ------------------------------------------------------
 -- |A 'CvContour' has a bounding 'CvRect' and a color.
 data CvContour = CvContour CvRect Int deriving (Show, Eq)
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/AI/CV/OpenCV/Core/HIplImage.hsc
index 9c2feac..e1dcb1c 100644
--- a/src/AI/CV/OpenCV/Core/HIplImage.hsc
+++ b/src/AI/CV/OpenCV/Core/HIplImage.hsc
@@ -20,7 +20,7 @@ module AI.CV.OpenCV.Core.HIplImage (
   ) where
 import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
                                  iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
-                                 CvRect(..))
+                                 CvRect(..), CvScalar(..))
 import AI.CV.OpenCV.Core.CV (cvCvtColor)
 import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
@@ -126,50 +126,50 @@ instance HasDepth Double where
 -- ensure that a scalar value to be used in an operation with an image
 -- is compatible with that image.
 class HasDepth d => HasScalar c d where
-    type CvScalar c d
+    type CvScalarT c d
 
 instance HasDepth d => HasScalar Monochromatic d where
-    type CvScalar Monochromatic d = d
+    type CvScalarT Monochromatic d = d
 
 instance HasDepth d => HasScalar Trichromatic d where
-    type CvScalar Trichromatic d = (d,d,d)
+    type CvScalarT Trichromatic d = (d,d,d)
 
 -- |Scalar types are often round-tripped via doubles in OpenCV to
 -- allow for non-overloaded interfaces of functions with scalar
 -- parameters.
 class IsCvScalar x where
-    toCvScalar :: x -> (CDouble, CDouble, CDouble, CDouble)
-    fromCvScalar :: (CDouble, CDouble, CDouble, CDouble) -> x
+    toCvScalar :: x -> CvScalar
+    fromCvScalar :: CvScalar -> x
 
 instance IsCvScalar Word8 where
     toCvScalar = depthToScalar
-    fromCvScalar (r,_,_,_) = floor r
+    fromCvScalar (CvScalar r _ _ _) = floor r
 
 instance IsCvScalar Word16 where
     toCvScalar = depthToScalar
-    fromCvScalar (r,_,_,_) = floor r
+    fromCvScalar (CvScalar r _ _ _) = floor r
 
 instance IsCvScalar Int16 where
     toCvScalar = depthToScalar
-    fromCvScalar (r,_,_,_) = floor r
+    fromCvScalar (CvScalar r _ _ _) = floor r
 
 instance IsCvScalar Float where
     toCvScalar = depthToScalar
-    fromCvScalar (r,_,_,_) = realToFrac r
+    fromCvScalar (CvScalar r _ _ _) = realToFrac r
 
 instance IsCvScalar Double where
     toCvScalar = depthToScalar
-    fromCvScalar (r,_,_,_) = realToFrac r
+    fromCvScalar (CvScalar r _ _ _) = realToFrac r
 
 instance (HasDepth d, IsCvScalar d) => IsCvScalar (d,d,d) where
     toCvScalar (r,g,b) = let f = realToFrac . toDouble
-                         in (f r, f g, f b, 0)
-    fromCvScalar (r,g,b,_) = let f = fromDouble . realToFrac 
-                             in (f r, f g, f b)
+                         in CvScalar (f r) (f g) (f b) 0
+    fromCvScalar (CvScalar r g b _) = let f = fromDouble . realToFrac 
+                                      in (f r, f g, f b)
 
-depthToScalar :: HasDepth d => d -> (CDouble, CDouble, CDouble, CDouble)
+depthToScalar :: HasDepth d => d -> CvScalar
 depthToScalar x = let x' = realToFrac (toDouble x)
-                  in (x', x', x', x')
+                  in CvScalar x' x' x' x'
 
 bytesPerPixel :: HasDepth d => d -> Int
 bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
index 0f24e35..5abc07c 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
@@ -23,13 +23,13 @@ void debug_print_image_header(IplImage *image)
            "\twidth: %d\n"
            "\theight: %d\n"
            "\timageSize: %d\n"
-           "\timageData: %x\n"
+           "\timageData: %p\n"
            "\twidthStep: %d\n"
-           "\timageDataOrigin: %x\n",
+           "\timageDataOrigin: %p\n",
            image->nSize, image->ID, image->nChannels, image->alphaChannel,
            image->depth, image->dataOrder, image->origin, image->align,
-           image->width, image->height, image->imageSize, (int)image->imageData, 
-           image->widthStep, (int)image->imageDataOrigin);
+           image->width, image->height, image->imageSize, image->imageData, 
+           image->widthStep, image->imageDataOrigin);
 }
 
 /****************************************************************************/
@@ -190,10 +190,10 @@ void c_cvGetROI(IplImage* img, int* rptr)
     rptr[3] = r.height;
 }
 
-void c_cvAvg(const CvArr *img, const CvArr *mask, double* avg)
+void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg)
 {
   CvScalar s = cvAvg(img, mask);
-  memcpy(avg, s.val, 4*sizeof(double));
+  memcpy(avg, &s, sizeof(CvScalar));
 }
 
 
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
index 870fb87..a85d924 100644
--- a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
@@ -46,7 +46,7 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
                      int header_size, int mode, int method, int offset_x, 
                      int offset_y);
 
-void c_cvAvg(const CvArr *img, const CvArr *mask, double* avg);
+void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg);
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               CvHaarClassifierCascade* cascade,
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
index d4f554a..f5d6632 100644
--- a/src/AI/CV/OpenCV/Core/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -244,3 +244,8 @@ enumToEventFlags x = map fst . filter snd $
                      zip [minBound..maxBound]
                          (map ((> 0) . (x .|.)) 
                               (map eventFlagToEnum [minBound..maxBound]))
+
+-- Qt fonts
+-- foreign import ccall "opencv2/highgui/highgui_c.h cvFontQt"
+--   cvFontQt :: CString -> CInt -> CDouble -> CDouble -> CDouble -> 
+--               CInt -> CInt -> CInt -> IO CvFont
\ No newline at end of file
diff --git a/src/AI/CV/OpenCV/Drawing.hs b/src/AI/CV/OpenCV/Drawing.hsc
similarity index 81%
rename from src/AI/CV/OpenCV/Drawing.hs
rename to src/AI/CV/OpenCV/Drawing.hsc
index 5562162..589f711 100644
--- a/src/AI/CV/OpenCV/Drawing.hs
+++ b/src/AI/CV/OpenCV/Drawing.hsc
@@ -1,8 +1,10 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
 module AI.CV.OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
                              LineType(..), RGB, drawLines, fillConvexPoly) where
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
+import AI.CV.OpenCV.Core.StorableUtil
 import Data.Bits ((.|.))
 import Foreign.C.String
 import Foreign.C.Types
@@ -36,6 +38,7 @@ initFont face italic hscale vscale shear thickness ltype =
 -- |Default sans-serif font.
 defaultFont :: Ptr CvFont
 defaultFont = unsafePerformIO $ initFont NormalSans False 1 1 0 1 EightConn
+{-# NOINLINE defaultFont #-}
 
 -- |Produce a text-drawing function given a font description. The
 -- application @prepFont face italic hscale vscale thickness@ produces
@@ -50,6 +53,17 @@ prepFont face italic hscale vscale thickness =
     prepFontAlt face italic hscale vscale 0 thickness EightConn
 {-# INLINE prepFont #-}
 
+#include <opencv2/core/core_c.h>
+
+#def void cvPutText_wrap(CvArr* img, const char* text, CvPoint* org,\
+                         const CvFont* font, CvScalar* color) {\
+  cvPutText(img, text, *org, font, *color);\
+}
+
+foreign import ccall "cvPutText_wrap" 
+  c_cvPutText :: Ptr CvArr -> CString -> Ptr CvPoint -> 
+                 Ptr CvFont -> Ptr CvScalar -> IO ()
+
 -- |Produce a text-drawing function given a font description. The
 -- application @prepFontAlt face italic hscale vscale shear thickness
 -- ltype@ produces a text-drawing function using a font with the given
@@ -64,7 +78,10 @@ prepFontAlt face italic hscale vscale shear thickness ltype =
     do f <- initFont face italic hscale vscale shear thickness ltype
        let go (x,y) (r,g,b) msg = cv $ \dst -> 
                                   withCString msg $ \msg' ->
-                                      cvPutText dst msg' x y f r g b
+                                  withS (CvPoint x y) $ \ptPtr ->
+                                  withS (CvScalar r g b 1) $ \colPtr ->
+                                    c_cvPutText dst msg' ptPtr f colPtr
+                                      --cvPutText dst msg' x y f r g b
            {-# INLINE go #-}
        return go
 {-# INLINE prepFontAlt #-}
@@ -74,9 +91,11 @@ putText :: (HasChannels c, HasDepth d, ImgBuilder r) =>
            HIplImage c d r -> HIplImage c d r
 putText (x,y) (r,g,b) msg = cv $ \dst ->
                             withCString msg $ \msg' ->
-                                cvPutText dst msg' x y defaultFont r g b
-                                -- c_cvPutText (castPtr dst) msg' (fi x) (fi y) 
-                                --             (fr r) (fr g) (fr b)
+                            withS (CvPoint x y) $ \ptPtr ->
+                            withS (CvScalar r g b 1) $ \colPtr ->
+                              c_cvPutText dst msg' ptPtr defaultFont colPtr
+                                -- cvPutText (castPtr dst) msg' (fi x) (fi y) 
+                                --            (fr r) (fr g) (fr b)
     -- where fi = fromIntegral
     --       fr = realToFrac
 {-# INLINE putText #-}
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 9f94d75..19ca43d 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -2,11 +2,12 @@
 -- |Miscellaneous image transformations.
 module AI.CV.OpenCV.FloodFill (floodFill, FloodRange(..)) where
 import Data.Bits ((.|.))
-import Foreign.C.Types (CDouble, CInt)
+import Foreign.C.Types (CInt)
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil
 import AI.CV.OpenCV.Core.CVOp
+import AI.CV.OpenCV.Core.StorableUtil
 
 -- |Flag used to indicate whether pixels under consideration for
 -- addition to a connected component should be compared to the seed
@@ -22,25 +23,32 @@ data FloodRange = FloodFixed | FloodFloating
 -- (e.g. bytes inserted between fields or at the end of the struct to
 -- ensure a desired alignment).
 
-foreign import ccall "opencv2/imgproc/imgproc_c.h cvFloodFill"
-  c_cvFloodFill :: Ptr CvArr -> CInt -> CInt -> 
-                   CDouble -> CDouble -> CDouble -> CDouble ->
-                   CDouble -> CDouble -> CDouble -> CDouble ->
-                   CDouble -> CDouble -> CDouble -> CDouble ->
-                   Ptr () -> CInt -> Ptr () -> IO ()
+#def void cvFloodFill_wrap(CvArr* img, CvPoint* seedPt,\
+                           CvScalar* newVal, CvScalar* loDiff,\
+                           CvScalar* upDiff, void *comp, int flags,\
+                           CvArr* mask) {\
+  cvFloodFill(img, *seedPt, *newVal, *loDiff, *upDiff, comp, flags, mask);\
+}
 
-type CvD = (CDouble, CDouble, CDouble, CDouble)
+-- "opencv2/imgproc/imgproc_c.h cvFloodFill"
+foreign import ccall "cvFloodFill_wrap" 
+  c_cvFloodFill :: Ptr CvArr -> Ptr CvPoint -> Ptr CvScalar -> Ptr CvScalar -> 
+                   Ptr CvScalar -> Ptr () -> CInt -> Ptr () -> IO ()
 
-floodHelper :: (Int, Int) -> CvD -> CvD -> CvD -> FloodRange -> 
+floodHelper :: (Int, Int) -> CvScalar -> CvScalar -> CvScalar -> FloodRange -> 
                Ptr IplImage -> IO ()
 floodHelper (x,y) newVal loDiff upDiff range src =
-    c_cvFloodFill (castPtr src) (fromIntegral x) (fromIntegral y) 
-                  nv1 nv2 nv3 nv4 lo1 lo2 lo3 lo4 up1 up2 up3 up4 
+  withS (CvPoint (fromIntegral x) (fromIntegral y)) $ \seedPtr ->
+  withS newVal $ \newValPtr ->
+  withS loDiff $ \loDiffPtr ->
+  withS upDiff $ \upDiffPtr ->
+    c_cvFloodFill (castPtr src) seedPtr newValPtr loDiffPtr upDiffPtr 
                   nullPtr flags nullPtr
-    where (nv1,nv2,nv3,nv4) = newVal
-          (lo1,lo2,lo3,lo4) = loDiff
-          (up1,up2,up3,up4) = upDiff
-          flags = case range of
+    -- c_cvFloodFill (castPtr src) 
+    --               (CvPoint (fromIntegral x) (fromIntegral y))
+    --               newVal loDiff upDiff
+    --               nullPtr flags nullPtr
+    where flags = case range of
                     FloodFixed -> 4 .|. #{const CV_FLOODFILL_FIXED_RANGE}
                     FloodFloating -> 4
 
@@ -55,7 +63,7 @@ floodHelper (x,y) newVal loDiff upDiff range src =
 -- painting should be compared to the seed pixel ('FloodFixed') or to
 -- their neighbors ('FloodFloating'); the source image.
 floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
-              IsCvScalar s, s ~ CvScalar c d, ImgBuilder r) => 
+              IsCvScalar s, s ~ CvScalarT c d, ImgBuilder r) => 
              (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d r -> 
              HIplImage c d r
 floodFill seed newVal loDiff upDiff range = 
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index 4b3212b..fbaff94 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -23,6 +23,9 @@ data ThresholdType = ThreshBinary
                    | ThreshToZeroInv
                      deriving Enum
 
+fromEnumC :: Enum a => a -> CInt
+fromEnumC = fromIntegral . fromEnum
+
 -- The OpenCV thresholding functions have the property that the source
 -- image must be a single-channel with 8-bit or float pixels. The
 -- destination image must be either the same pixel type as the source,
@@ -72,7 +75,7 @@ cvThreshold1 threshold maxValue tType =
 
 -- The worker function that calls c_cvThreshold.
 cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
-                d1 -> d1 -> Int -> HIplImage Monochromatic d1 r ->
+                d1 -> d1 -> CInt -> HIplImage Monochromatic d1 r ->
                 HIplImage Monochromatic d2 r
 cvThreshold2 threshold maxValue tType = 
     cv2 $ \src dst ->
@@ -88,7 +91,7 @@ cvThreshold2 threshold maxValue tType =
 --                HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 -- cvThreshold = doThreshold
 cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
-               d1 -> d1 -> Int -> 
+               d1 -> d1 -> CInt -> 
                HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 cvThreshold = cvThreshold2
 
@@ -97,7 +100,7 @@ cvThreshold = cvThreshold2
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
 cvThresholdOtsu :: Inplace r M Word8 M Word8 =>
-                   Word8 -> Int -> HIplImage Monochromatic Word8 r ->
+                   Word8 -> CInt -> HIplImage Monochromatic Word8 r ->
                    HIplImage Monochromatic Word8 r
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
@@ -113,7 +116,7 @@ type M = Monochromatic
 thresholdBinary :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                    d1 -> d1 -> 
                    HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
-thresholdBinary th maxValue = cvThreshold th maxValue (fromEnum ThreshBinary)
+thresholdBinary th maxValue = cvThreshold th maxValue (fromEnumC ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
@@ -124,7 +127,7 @@ thresholdBinaryInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) =>
                       d1 -> d1 -> 
                       HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
-    where tType = fromEnum ThreshBinaryInv
+    where tType = fromEnumC ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
 
 -- |Truncation thresholding (i.e. clamping). Parameters are the
@@ -133,7 +136,7 @@ thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
 -- pixels unchanged.
 thresholdTruncate :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                      d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
-thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
+thresholdTruncate threshold = cvThreshold threshold 0 (fromEnumC ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
@@ -141,7 +144,7 @@ thresholdTruncate threshold = cvThreshold threshold 0 (fromEnum ThreshTrunc)
 -- and the source 'HIplImage'.
 thresholdToZero :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                    d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
-thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
+thresholdToZero threshold = cvThreshold threshold 0 (fromEnumC ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
@@ -150,18 +153,18 @@ thresholdToZero threshold = cvThreshold threshold 0 (fromEnum ThreshToZero)
 thresholdToZeroInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                       d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
 thresholdToZeroInv threshold = cvThreshold threshold 0 tType
-    where tType = fromEnum ThreshToZeroInv
+    where tType = fromEnumC ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
 
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
--- thresholded image. Takes the @maxValue@ to replace pixels that pass
--- the threshold with and the source 'HIplImage'.
+-- thresholded image. Takes the @maxValue@ used to replace pixels that
+-- pass the threshold with and the source 'HIplImage'.
 thresholdBinaryOtsu :: (Inplace r M Word8 M Word8) =>
                        Word8 -> HIplImage Monochromatic Word8 r ->
                        HIplImage Monochromatic Word8 r
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
-    where tType = fromEnum ThreshBinary
+    where tType = fromEnumC ThreshBinary
 {-# INLINE thresholdBinaryOtsu #-}
 
 -- |Binary thresholding using Otsu's method to determine an optimal
@@ -173,7 +176,7 @@ thresholdBinaryOtsuInv :: (Inplace r M Word8 M Word8) =>
                           Word8 -> HIplImage Monochromatic Word8 r ->
                           HIplImage Monochromatic Word8 r
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
-    where tType = fromEnum ThreshBinaryInv
+    where tType = fromEnumC ThreshBinaryInv
 {-# INLINE thresholdBinaryOtsuInv #-}
 
 -- |Maps pixels that are greater than @threshold@ to the @threshold@
@@ -183,7 +186,7 @@ thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
 thresholdTruncateOtsu :: (Inplace r M Word8 M Word8) =>
                          HIplImage Monochromatic Word8 r -> 
                          HIplImage Monochromatic Word8 r
-thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
+thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnumC ThreshTrunc)
 {-# INLINE thresholdTruncateOtsu #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
@@ -192,7 +195,7 @@ thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnum ThreshTrunc)
 thresholdToZeroOtsu :: (Inplace r M Word8 M Word8) =>
                        HIplImage Monochromatic Word8 r -> 
                        HIplImage Monochromatic Word8 r
-thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
+thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnumC ThreshToZero)
 {-# INLINE thresholdToZeroOtsu #-}
 
 -- |Maps pixels that are greather than @threshold@ to zero; leaves all
@@ -201,5 +204,5 @@ thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnum ThreshToZero)
 thresholdToZeroOtsuInv :: (Inplace r M Word8 M Word8) =>
                           HIplImage Monochromatic Word8 r -> 
                           HIplImage Monochromatic Word8 r
-thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnum ThreshToZeroInv)
+thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnumC ThreshToZeroInv)
 {-# INLINE thresholdToZeroOtsuInv #-}
diff --git a/src/Examples/VideoFunhouse/Makefile b/src/Examples/VideoFunhouse/Makefile
index 811572e..cf3ef65 100644
--- a/src/Examples/VideoFunhouse/Makefile
+++ b/src/Examples/VideoFunhouse/Makefile
@@ -1,2 +1,5 @@
 all:	VideoFunhouse.hs Rate.hs
 	ghc -O2 VideoFunhouse.hs -fforce-recomp -rtsopts -threaded -fspec-constr-count=18 -with-rtsopts="-A4M"
+
+clean:
+	rm *.hi *.o VideoFunhouse
\ No newline at end of file

From 134153bc3a8c04700245662c8bdcb713e4fc32b2 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 13 Mar 2012 12:48:04 -0400
Subject: [PATCH 113/137] Explicitly import constructors of types used in
 foreign imports to address warnings in GHC 7.4.

---
 src/AI/CV/OpenCV/ArrayOps.hsc        | 2 +-
 src/AI/CV/OpenCV/FeatureDetection.hs | 2 +-
 src/AI/CV/OpenCV/Filtering.hsc       | 2 +-
 src/AI/CV/OpenCV/FloodFill.hsc       | 2 +-
 src/AI/CV/OpenCV/Threshold.hs        | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/AI/CV/OpenCV/ArrayOps.hsc b/src/AI/CV/OpenCV/ArrayOps.hsc
index e44e1ea..40f2961 100644
--- a/src/AI/CV/OpenCV/ArrayOps.hsc
+++ b/src/AI/CV/OpenCV/ArrayOps.hsc
@@ -9,7 +9,7 @@ module AI.CV.OpenCV.ArrayOps (subRS, absDiff, abs, convertScale,
                               ComparisonOp(..), isolateChannel, copy,
                               replaceChannel, convertScaleAbs, absSat) where
 import Data.Word (Word8)
-import Foreign.C.Types (CDouble, CInt)
+import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/AI/CV/OpenCV/FeatureDetection.hs
index 8780717..b697a4e 100644
--- a/src/AI/CV/OpenCV/FeatureDetection.hs
+++ b/src/AI/CV/OpenCV/FeatureDetection.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface, FlexibleContexts #-}
 -- |Feature Detection.
 module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
-import Foreign.C.Types (CInt, CDouble)
+import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/AI/CV/OpenCV/Filtering.hsc
index fe09149..f70dd19 100644
--- a/src/AI/CV/OpenCV/Filtering.hsc
+++ b/src/AI/CV/OpenCV/Filtering.hsc
@@ -5,7 +5,7 @@ module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian',
                                ApertureSize(..), DerivativeOrder(..)) where
 import Data.Word (Word8)
 import Data.Int (Int16)
-import Foreign.C.Types (CInt, CDouble)
+import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
 import AI.CV.OpenCV.Core.CxCore
 import AI.CV.OpenCV.Core.HIplUtil
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/AI/CV/OpenCV/FloodFill.hsc
index 19ca43d..cb2e595 100644
--- a/src/AI/CV/OpenCV/FloodFill.hsc
+++ b/src/AI/CV/OpenCV/FloodFill.hsc
@@ -2,7 +2,7 @@
 -- |Miscellaneous image transformations.
 module AI.CV.OpenCV.FloodFill (floodFill, FloodRange(..)) where
 import Data.Bits ((.|.))
-import Foreign.C.Types (CInt)
+import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/AI/CV/OpenCV/Threshold.hs
index fbaff94..696d13b 100644
--- a/src/AI/CV/OpenCV/Threshold.hs
+++ b/src/AI/CV/OpenCV/Threshold.hs
@@ -10,7 +10,7 @@ module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
                                thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
 import Data.Bits ((.|.))
 import Data.Word (Word8)
-import Foreign.C.Types (CDouble, CInt)
+import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr)
 import AI.CV.OpenCV.Core.CxCore 
 import AI.CV.OpenCV.Core.HIplUtil

From adab0de53516a91d98218ff0ddcb442e0c5c3fea Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 13 Mar 2012 12:48:53 -0400
Subject: [PATCH 114/137] Conditional compilation to avoid redifining the
 Monoid append operator (<>) with base >= 4.5.

---
 src/AI/CV/OpenCV/Core/CVOp.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/AI/CV/OpenCV/Core/CVOp.hs
index 3ea3305..ced1e85 100644
--- a/src/AI/CV/OpenCV/Core/CVOp.hs
+++ b/src/AI/CV/OpenCV/Core/CVOp.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances,
-             TypeSynonymInstances #-}
+             TypeSynonymInstances, CPP #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 --
@@ -81,9 +81,11 @@ bi2unary = CVOp . dupArg . binop
 unary2bi :: CVOp c d -> BinOp (c,d) (c,d)
 unary2bi = BinOp . const . op
 
+#ifdef MAX_VERSION_base(4,4,0)
 (<>) :: Monoid m => m -> m -> m
 (<>) = mappend
 {-# INLINE (<>) #-}
+#endif
 
 -- |Some operations benefit from operating in-place over a defined
 -- region-of-interest (ROI). If an operation must recompute every

From 8dc9dc81cf2a8ee7c9f68bae7c12d143ee53ca9f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 13 Mar 2012 12:49:46 -0400
Subject: [PATCH 115/137] Added a 'numPixels' accessor for images.

---
 src/AI/CV/OpenCV/Core/HIplUtil.hs | 10 +++++++---
 src/AI/CV/OpenCV/HighCV.hs        |  2 +-
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/AI/CV/OpenCV/Core/HIplUtil.hs
index f95f91f..a8866ba 100644
--- a/src/AI/CV/OpenCV/Core/HIplUtil.hs
+++ b/src/AI/CV/OpenCV/Core/HIplUtil.hs
@@ -7,9 +7,9 @@ module AI.CV.OpenCV.Core.HIplUtil
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, setROI, resetROI,
-     mkHIplImage, width, height, mkBlackImage, HIplImage, NoROI, HasROI,
-     withHIplImage, Monochromatic, Trichromatic, HasChannels, ImgBuilder(..),
-     GrayImage, GrayImage16, GrayImage16S, ColorImage, 
+     mkHIplImage, width, height, numPixels, mkBlackImage, HIplImage, 
+     NoROI, HasROI, withHIplImage, Monochromatic, Trichromatic, HasChannels, 
+     ImgBuilder(..), GrayImage, GrayImage16, GrayImage16S, ColorImage, 
      c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
@@ -76,6 +76,10 @@ imgChannels _ = fromIntegral $ numChannels (undefined::c)
 colorDepth :: forall c d r. HasDepth d => HIplImage c d r -> Int
 colorDepth _ = bytesPerPixel (undefined::d)
 
+-- |The number of pixels in the image: @width img * height img@.
+numPixels :: HIplImage c d r -> Int
+numPixels = fromIntegral . ((*) <$> width <*> height)
+
 -- |Apply the supplied function to a 'V.Vector' containing the pixels
 -- that make up an 'HIplImage'. This does not copy the underlying
 -- data.
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/AI/CV/OpenCV/HighCV.hs
index 22531a4..eb90e72 100644
--- a/src/AI/CV/OpenCV/HighCV.hs
+++ b/src/AI/CV/OpenCV/HighCV.hs
@@ -7,7 +7,7 @@ module AI.CV.OpenCV.HighCV (
                             fromFile, fromFileGray, fromFileColor, 
                             fromPGM16, toFile,
                             -- * Image Properties
-                            width, height, isColor, isMono,
+                            width, height, numPixels, isColor, isMono,
                             -- * Image Construction
                             fromPixels, fromGrayPixels, fromColorPixels, 
                             fromPtr,

From 49fa8a587c70b154b031aaf80269f295257bb863 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 13 Mar 2012 12:50:48 -0400
Subject: [PATCH 116/137] Removed dependency on allocated-processor package.

---
 HOpenCV.cabal                     |  3 +--
 src/AI/CV/OpenCV/Core/CxCore.hsc  | 25 +++++++++++++++++++++----
 src/AI/CV/OpenCV/Core/HighGui.hsc |  1 -
 3 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 33f7d9e..75a2871 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,5 +1,5 @@
 name: HOpenCV
-version: 0.2.1
+version: 0.2.2
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
@@ -81,7 +81,6 @@ library
        extra-libraries: opencv_core,opencv_imgproc,opencv_highgui,opencv_video
    build-depends: base >=4 && <5, 
                   template-haskell,
-                  allocated-processor >= 0.0.1, 
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
                   vector >= 0.7
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/AI/CV/OpenCV/Core/CxCore.hsc
index 0e0c39c..37be23a 100644
--- a/src/AI/CV/OpenCV/Core/CxCore.hsc
+++ b/src/AI/CV/OpenCV/Core/CxCore.hsc
@@ -1,17 +1,15 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
-
 module AI.CV.OpenCV.Core.CxCore where
 import Control.Applicative
+import Control.Monad ((>=>))
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.ForeignPtr
-import Foreign.ForeignPtrWrap
 import Foreign.Marshal.Alloc
 import Foreign.Marshal.Array
 import Foreign.Ptr
 import Foreign.Storable
---import System.IO.Unsafe (unsafePerformIO)
-
+import System.IO.Error (modifyIOError)
 import Data.VectorSpace as VectorSpace
 
 #include <opencv2/core/core_c.h>
@@ -408,6 +406,25 @@ newtype CmpOp = CmpOp { unCmpOp :: CInt }
 ptrToMaybe :: Ptr a -> Maybe (Ptr a)
 ptrToMaybe p = if p == nullPtr then Nothing else Just p
 
+-- |Add a 'String' name to a thrown error.
+-- NOTE: adapated from the allocated-processor packge.
+errorName :: String -> IO a -> IO a
+errorName = modifyIOError . const . userError
+
+-- |Fail if an action results in a null pointer. 
+-- NOTE: adapted from the allocated-processor package.
+checkPtr :: IO (Ptr a) -> IO (Ptr a)
+checkPtr = (>>= aux)
+  where aux r | r == nullPtr = fail "Null Pointer"
+              | otherwise = return r
+
+-- |Wrap a 'ForeignPtr' around a 'Ptr' after checking that the 'Ptr'
+-- is non-null. The supplied finalizer is attached to the
+-- 'ForeignPtr'.
+-- NOTE: adapted from the allocated-processor package.
+createForeignPtr :: FunPtr (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
+createForeignPtr = (checkPtr >=>) . newForeignPtr
+
 ------------------------------------------------------------------------------
 -- Debugging stuff, not part of opencv
 
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/AI/CV/OpenCV/Core/HighGui.hsc
index f5d6632..413d04e 100644
--- a/src/AI/CV/OpenCV/Core/HighGui.hsc
+++ b/src/AI/CV/OpenCV/Core/HighGui.hsc
@@ -13,7 +13,6 @@ module AI.CV.OpenCV.Core.HighGui
      windowFlagsToEnum, Event(..), EventFlag(..)) where
 
 import Data.Bits ((.&.), (.|.), shiftL) 
-import Foreign.ForeignPtrWrap
 import Foreign.C.Types
 import Foreign.Ptr
 import Foreign.ForeignPtr

From 97c6a618b3b82bb9dbef4181f6e7c7a440b1d1c4 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 13 Mar 2012 12:55:33 -0400
Subject: [PATCH 117/137] Updated notice of OpenCV compatibility with 2.3.1 in
 README.

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 30ed590..c7e8e3f 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 # HOpenCV
 
 [OpenCV](http://opencv.willowgarage.com/wiki/) bindings for Haskell
-(tested with OpenCV 2.1, 2.2, and 2.3).
+(tested with OpenCV 2.1, 2.2, 2.3.0, and 2.3.1).
 
 - Image color channel count and color depth are statically checked.
 

From 5c66a8356d3a96da6f89de891c23e125bf9bb4ee Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Wed, 14 Mar 2012 21:15:49 -0400
Subject: [PATCH 118/137] Added Storable utility module.

---
 src/AI/CV/OpenCV/Core/StorableUtil.hs | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 src/AI/CV/OpenCV/Core/StorableUtil.hs

diff --git a/src/AI/CV/OpenCV/Core/StorableUtil.hs b/src/AI/CV/OpenCV/Core/StorableUtil.hs
new file mode 100644
index 0000000..081bd00
--- /dev/null
+++ b/src/AI/CV/OpenCV/Core/StorableUtil.hs
@@ -0,0 +1,7 @@
+module AI.CV.OpenCV.Core.StorableUtil where
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (Storable(poke))
+import Foreign.Ptr (Ptr)
+
+withS :: Storable a => a -> (Ptr a -> IO b) -> IO b
+withS x f = alloca $ \ptr -> poke ptr x >> f ptr
\ No newline at end of file

From 62f5a824e72773b2e8b3069a6360f48a43baa33b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Wed, 19 Sep 2012 17:19:22 -0400
Subject: [PATCH 119/137] Moved files.

---
 HOpenCV.cabal                                 | 60 +++++++++----------
 src/{AI/CV => }/OpenCV/ArrayOps.hsc           |  0
 src/{AI/CV => }/OpenCV/ColorConversion.hs     |  0
 src/{AI/CV => }/OpenCV/Contours.hsc           |  0
 src/{AI/CV => }/OpenCV/Core/CV.hsc            |  0
 src/{AI/CV => }/OpenCV/Core/CVOp.hs           |  0
 .../CV => }/OpenCV/Core/ColorConversion.hsc   |  0
 src/{AI/CV => }/OpenCV/Core/CxCore.hsc        |  0
 src/{AI/CV => }/OpenCV/Core/HIplImage.hsc     |  0
 src/{AI/CV => }/OpenCV/Core/HIplUtil.hs       |  0
 src/{AI/CV => }/OpenCV/Core/HOpenCV_wrap.c    |  0
 src/{AI/CV => }/OpenCV/Core/HOpenCV_wrap.h    |  0
 src/{AI/CV => }/OpenCV/Core/HighGui.hsc       |  0
 src/{AI/CV => }/OpenCV/Core/StorableUtil.hs   |  0
 src/{AI/CV => }/OpenCV/Drawing.hsc            |  0
 src/{AI/CV => }/OpenCV/FeatureDetection.hs    |  0
 src/{AI/CV => }/OpenCV/Filtering.hsc          |  0
 src/{AI/CV => }/OpenCV/FloodFill.hsc          |  0
 src/{AI/CV => }/OpenCV/GUI.hs                 |  0
 src/{AI/CV => }/OpenCV/HighCV.hs              |  0
 src/{AI/CV => }/OpenCV/Histograms.hs          |  0
 src/{AI/CV => }/OpenCV/Motion.hsc             |  0
 src/{AI/CV => }/OpenCV/PixelUtils.hs          |  0
 src/{AI/CV => }/OpenCV/Threshold.hs           |  0
 src/{AI/CV => }/OpenCV/Video.hs               |  0
 25 files changed, 30 insertions(+), 30 deletions(-)
 rename src/{AI/CV => }/OpenCV/ArrayOps.hsc (100%)
 rename src/{AI/CV => }/OpenCV/ColorConversion.hs (100%)
 rename src/{AI/CV => }/OpenCV/Contours.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/CV.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/CVOp.hs (100%)
 rename src/{AI/CV => }/OpenCV/Core/ColorConversion.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/CxCore.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/HIplImage.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/HIplUtil.hs (100%)
 rename src/{AI/CV => }/OpenCV/Core/HOpenCV_wrap.c (100%)
 rename src/{AI/CV => }/OpenCV/Core/HOpenCV_wrap.h (100%)
 rename src/{AI/CV => }/OpenCV/Core/HighGui.hsc (100%)
 rename src/{AI/CV => }/OpenCV/Core/StorableUtil.hs (100%)
 rename src/{AI/CV => }/OpenCV/Drawing.hsc (100%)
 rename src/{AI/CV => }/OpenCV/FeatureDetection.hs (100%)
 rename src/{AI/CV => }/OpenCV/Filtering.hsc (100%)
 rename src/{AI/CV => }/OpenCV/FloodFill.hsc (100%)
 rename src/{AI/CV => }/OpenCV/GUI.hs (100%)
 rename src/{AI/CV => }/OpenCV/HighCV.hs (100%)
 rename src/{AI/CV => }/OpenCV/Histograms.hs (100%)
 rename src/{AI/CV => }/OpenCV/Motion.hsc (100%)
 rename src/{AI/CV => }/OpenCV/PixelUtils.hs (100%)
 rename src/{AI/CV => }/OpenCV/Threshold.hs (100%)
 rename src/{AI/CV => }/OpenCV/Video.hs (100%)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 75a2871..1ac9014 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -8,7 +8,7 @@ category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
 Tested-With:   GHC==7.0.3
 description:
-   Limited bindings to OpenCV 2.3. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
+   Limited bindings to OpenCV 2.4. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
    /Installation/
    .
@@ -16,12 +16,12 @@ description:
    .
    /Usage/
    .
-   The "AI.CV.OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations. While the @Core@ modules contain to low-level OpenCV interfaces.
+   The "OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations. While the @Core@ modules contain to low-level OpenCV interfaces.
    .
    See @src\/Examples\/VideoFunhouse@ for an example application.
 build-type:         Custom
 cabal-version:      >= 1.8
-extra-source-files: src/AI/CV/OpenCV/Core/HOpenCV_wrap.h 
+extra-source-files: src/OpenCV/Core/HOpenCV_wrap.h 
                     src/Examples/VideoFunhouse/Makefile 
                     src/Examples/VideoFunhouse/Rate.hs
                     src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -40,35 +40,35 @@ Flag MotionAnalysis
 
 library
    exposed-modules:
-      AI.CV.OpenCV.Core.CV
-      AI.CV.OpenCV.Core.CVOp 
-      AI.CV.OpenCV.Core.CxCore
-      AI.CV.OpenCV.Core.HighGui
-      AI.CV.OpenCV.Core.HIplImage
-      AI.CV.OpenCV.Core.HIplUtil
-      AI.CV.OpenCV.Core.ColorConversion
-      AI.CV.OpenCV.HighCV
-      AI.CV.OpenCV.GUI
-      AI.CV.OpenCV.Video
-      AI.CV.OpenCV.FloodFill
-      AI.CV.OpenCV.PixelUtils
-      AI.CV.OpenCV.ColorConversion
-      AI.CV.OpenCV.Drawing
-      AI.CV.OpenCV.Contours
-      AI.CV.OpenCV.Threshold
-      AI.CV.OpenCV.ArrayOps
-      AI.CV.OpenCV.Filtering
-      AI.CV.OpenCV.FeatureDetection
-      AI.CV.OpenCV.Histograms
+      OpenCV.Core.CV
+      OpenCV.Core.CVOp 
+      OpenCV.Core.CxCore
+      OpenCV.Core.HighGui
+      OpenCV.Core.HIplImage
+      OpenCV.Core.HIplUtil
+      OpenCV.Core.ColorConversion
+      OpenCV.HighCV
+      OpenCV.GUI
+      OpenCV.Video
+      OpenCV.FloodFill
+      OpenCV.PixelUtils
+      OpenCV.ColorConversion
+      OpenCV.Drawing
+      OpenCV.Contours
+      OpenCV.Threshold
+      OpenCV.ArrayOps
+      OpenCV.Filtering
+      OpenCV.FeatureDetection
+      OpenCV.Histograms
    c-sources:
-      src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
-      src/AI/CV/OpenCV/ArrayOps_hsc.c
-      src/AI/CV/OpenCV/FloodFill_hsc.c
-      src/AI/CV/OpenCV/Drawing_hsc.c
-   other-modules: AI.CV.OpenCV.Core.StorableUtil
+      src/OpenCV/Core/HOpenCV_wrap.c
+      src/OpenCV/ArrayOps_hsc.c
+      src/OpenCV/FloodFill_hsc.c
+      src/OpenCV/Drawing_hsc.c
+   other-modules: OpenCV.Core.StorableUtil
    hs-Source-Dirs: src
    if flag(MotionAnalysis)
-     exposed-modules:   AI.CV.OpenCV.Motion
+     exposed-modules:   OpenCV.Motion
    if os(windows)
      include-dirs:	C:\\OpenCV2.2\\include
      extra-lib-dirs:	C:\\OpenCV2.2\\bin
@@ -84,4 +84,4 @@ library
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
                   vector >= 0.7
-   ghc-options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -O2 -funbox-strict-fields
+   ghc-options: -Wall -fno-warn-name-shadowing -O2 -funbox-strict-fields
diff --git a/src/AI/CV/OpenCV/ArrayOps.hsc b/src/OpenCV/ArrayOps.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/ArrayOps.hsc
rename to src/OpenCV/ArrayOps.hsc
diff --git a/src/AI/CV/OpenCV/ColorConversion.hs b/src/OpenCV/ColorConversion.hs
similarity index 100%
rename from src/AI/CV/OpenCV/ColorConversion.hs
rename to src/OpenCV/ColorConversion.hs
diff --git a/src/AI/CV/OpenCV/Contours.hsc b/src/OpenCV/Contours.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Contours.hsc
rename to src/OpenCV/Contours.hsc
diff --git a/src/AI/CV/OpenCV/Core/CV.hsc b/src/OpenCV/Core/CV.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Core/CV.hsc
rename to src/OpenCV/Core/CV.hsc
diff --git a/src/AI/CV/OpenCV/Core/CVOp.hs b/src/OpenCV/Core/CVOp.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Core/CVOp.hs
rename to src/OpenCV/Core/CVOp.hs
diff --git a/src/AI/CV/OpenCV/Core/ColorConversion.hsc b/src/OpenCV/Core/ColorConversion.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Core/ColorConversion.hsc
rename to src/OpenCV/Core/ColorConversion.hsc
diff --git a/src/AI/CV/OpenCV/Core/CxCore.hsc b/src/OpenCV/Core/CxCore.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Core/CxCore.hsc
rename to src/OpenCV/Core/CxCore.hsc
diff --git a/src/AI/CV/OpenCV/Core/HIplImage.hsc b/src/OpenCV/Core/HIplImage.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Core/HIplImage.hsc
rename to src/OpenCV/Core/HIplImage.hsc
diff --git a/src/AI/CV/OpenCV/Core/HIplUtil.hs b/src/OpenCV/Core/HIplUtil.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Core/HIplUtil.hs
rename to src/OpenCV/Core/HIplUtil.hs
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.c b/src/OpenCV/Core/HOpenCV_wrap.c
similarity index 100%
rename from src/AI/CV/OpenCV/Core/HOpenCV_wrap.c
rename to src/OpenCV/Core/HOpenCV_wrap.c
diff --git a/src/AI/CV/OpenCV/Core/HOpenCV_wrap.h b/src/OpenCV/Core/HOpenCV_wrap.h
similarity index 100%
rename from src/AI/CV/OpenCV/Core/HOpenCV_wrap.h
rename to src/OpenCV/Core/HOpenCV_wrap.h
diff --git a/src/AI/CV/OpenCV/Core/HighGui.hsc b/src/OpenCV/Core/HighGui.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Core/HighGui.hsc
rename to src/OpenCV/Core/HighGui.hsc
diff --git a/src/AI/CV/OpenCV/Core/StorableUtil.hs b/src/OpenCV/Core/StorableUtil.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Core/StorableUtil.hs
rename to src/OpenCV/Core/StorableUtil.hs
diff --git a/src/AI/CV/OpenCV/Drawing.hsc b/src/OpenCV/Drawing.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Drawing.hsc
rename to src/OpenCV/Drawing.hsc
diff --git a/src/AI/CV/OpenCV/FeatureDetection.hs b/src/OpenCV/FeatureDetection.hs
similarity index 100%
rename from src/AI/CV/OpenCV/FeatureDetection.hs
rename to src/OpenCV/FeatureDetection.hs
diff --git a/src/AI/CV/OpenCV/Filtering.hsc b/src/OpenCV/Filtering.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Filtering.hsc
rename to src/OpenCV/Filtering.hsc
diff --git a/src/AI/CV/OpenCV/FloodFill.hsc b/src/OpenCV/FloodFill.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/FloodFill.hsc
rename to src/OpenCV/FloodFill.hsc
diff --git a/src/AI/CV/OpenCV/GUI.hs b/src/OpenCV/GUI.hs
similarity index 100%
rename from src/AI/CV/OpenCV/GUI.hs
rename to src/OpenCV/GUI.hs
diff --git a/src/AI/CV/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
similarity index 100%
rename from src/AI/CV/OpenCV/HighCV.hs
rename to src/OpenCV/HighCV.hs
diff --git a/src/AI/CV/OpenCV/Histograms.hs b/src/OpenCV/Histograms.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Histograms.hs
rename to src/OpenCV/Histograms.hs
diff --git a/src/AI/CV/OpenCV/Motion.hsc b/src/OpenCV/Motion.hsc
similarity index 100%
rename from src/AI/CV/OpenCV/Motion.hsc
rename to src/OpenCV/Motion.hsc
diff --git a/src/AI/CV/OpenCV/PixelUtils.hs b/src/OpenCV/PixelUtils.hs
similarity index 100%
rename from src/AI/CV/OpenCV/PixelUtils.hs
rename to src/OpenCV/PixelUtils.hs
diff --git a/src/AI/CV/OpenCV/Threshold.hs b/src/OpenCV/Threshold.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Threshold.hs
rename to src/OpenCV/Threshold.hs
diff --git a/src/AI/CV/OpenCV/Video.hs b/src/OpenCV/Video.hs
similarity index 100%
rename from src/AI/CV/OpenCV/Video.hs
rename to src/OpenCV/Video.hs

From 6d631ca64d6f8784342dea23c0abacc2821f159b Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Wed, 19 Sep 2012 17:32:14 -0400
Subject: [PATCH 120/137] Fixed module names.

---
 HOpenCV.cabal                               |  4 +-
 Setup.hs                                    |  2 +-
 src/Examples/OneOffs/Closing.hs             |  2 +-
 src/Examples/OneOffs/EqualizeCenter.hs      |  6 +-
 src/Examples/PerfTest/PerfTest.hs           |  6 +-
 src/Examples/VideoFunhouse/VideoFunhouse.hs |  8 +-
 src/OpenCV/ArrayOps.hsc                     | 24 +++---
 src/OpenCV/ColorConversion.hs               | 10 +--
 src/OpenCV/Contours.hsc                     |  6 +-
 src/OpenCV/Core/CV.hsc                      |  6 +-
 src/OpenCV/Core/CVOp.hs                     |  8 +-
 src/OpenCV/Core/ColorConversion.hsc         |  2 +-
 src/OpenCV/Core/CxCore.hsc                  |  2 +-
 src/OpenCV/Core/HIplImage.hsc               | 12 +--
 src/OpenCV/Core/HIplUtil.hs                 | 12 +--
 src/OpenCV/Core/HighGui.hsc                 |  4 +-
 src/OpenCV/Core/StorableUtil.hs             |  2 +-
 src/OpenCV/Drawing.hsc                      | 12 +--
 src/OpenCV/FeatureDetection.hs              |  8 +-
 src/OpenCV/Filtering.hsc                    | 12 +--
 src/OpenCV/FloodFill.hsc                    | 10 +--
 src/OpenCV/GUI.hs                           | 10 +--
 src/OpenCV/HighCV.hs                        | 88 ++++++++++-----------
 src/OpenCV/Histograms.hs                    |  8 +-
 src/OpenCV/Motion.hsc                       |  6 +-
 src/OpenCV/PixelUtils.hs                    |  8 +-
 src/OpenCV/Threshold.hs                     | 18 ++---
 src/OpenCV/Video.hs                         | 12 +--
 28 files changed, 154 insertions(+), 154 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 1ac9014..dffb275 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,12 +1,12 @@
 name: HOpenCV
-version: 0.2.2
+version: 0.3.0
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
 stability: experimental
 category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
-Tested-With:   GHC==7.0.3
+Tested-With:   GHC==7.4.1
 description:
    Limited bindings to OpenCV 2.4. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
diff --git a/Setup.hs b/Setup.hs
index 6516886..b745d2d 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -12,7 +12,7 @@ runHsc2hs f = system $ "hsc2hs "++f++" "++libs'
   where libs' = intercalate " " $ map ("-L -l"++) libs
 
 srcPath :: FilePath
-srcPath = "src/AI/CV/OpenCV"
+srcPath = "src/OpenCV"
 
 main :: IO ()
 main = do mapM_ (runHsc2hs . (srcPath </>) . flip addExtension "hsc")
diff --git a/src/Examples/OneOffs/Closing.hs b/src/Examples/OneOffs/Closing.hs
index cc44d56..bdad420 100644
--- a/src/Examples/OneOffs/Closing.hs
+++ b/src/Examples/OneOffs/Closing.hs
@@ -1,3 +1,3 @@
-import AI.CV.OpenCV.HighCV
+import OpenCV.HighCV
 
 main = toFile "closed.png" . erode 8 . dilate 8 =<< fromFileGray "input.png"
\ No newline at end of file
diff --git a/src/Examples/OneOffs/EqualizeCenter.hs b/src/Examples/OneOffs/EqualizeCenter.hs
index c7c2644..bda4274 100644
--- a/src/Examples/OneOffs/EqualizeCenter.hs
+++ b/src/Examples/OneOffs/EqualizeCenter.hs
@@ -1,7 +1,7 @@
 import Control.Applicative
-import AI.CV.OpenCV.HighCV
-import AI.CV.OpenCV.ArrayOps
-import AI.CV.OpenCV.Histograms
+import OpenCV.HighCV
+import OpenCV.ArrayOps
+import OpenCV.Histograms
 
 boostSaturation :: ColorImage -> ColorImage
 boostSaturation img = convertHSVToBGR $ replaceChannel 1 s hsv
diff --git a/src/Examples/PerfTest/PerfTest.hs b/src/Examples/PerfTest/PerfTest.hs
index ecc4918..4d4e294 100644
--- a/src/Examples/PerfTest/PerfTest.hs
+++ b/src/Examples/PerfTest/PerfTest.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeSynonymInstances #-}
-import AI.CV.OpenCV.HighCV
-import AI.CV.OpenCV.ArrayOps
-import AI.CV.OpenCV.Filtering
+import OpenCV.HighCV
+import OpenCV.ArrayOps
+import OpenCV.Filtering
 import Control.Parallel
 import Criterion.Main
 
diff --git a/src/Examples/VideoFunhouse/VideoFunhouse.hs b/src/Examples/VideoFunhouse/VideoFunhouse.hs
index 4f79c06..d72ee31 100644
--- a/src/Examples/VideoFunhouse/VideoFunhouse.hs
+++ b/src/Examples/VideoFunhouse/VideoFunhouse.hs
@@ -2,10 +2,10 @@
 -- the video feed from an attached webcam or a video file specified as
 -- a command line argument. The executable prints usage instructions
 -- to the console when run.
-import AI.CV.OpenCV.HighCV
-import AI.CV.OpenCV.ArrayOps
-import AI.CV.OpenCV.Filtering
-import AI.CV.OpenCV.Histograms
+import OpenCV.HighCV
+import OpenCV.ArrayOps
+import OpenCV.Filtering
+import OpenCV.Histograms
 import Control.Applicative
 import Control.Parallel
 import System.Environment (getArgs)
diff --git a/src/OpenCV/ArrayOps.hsc b/src/OpenCV/ArrayOps.hsc
index 40f2961..5d1477a 100644
--- a/src/OpenCV/ArrayOps.hsc
+++ b/src/OpenCV/ArrayOps.hsc
@@ -1,13 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables,
              FlexibleContexts #-}
 -- |Array operations.
-module AI.CV.OpenCV.ArrayOps (subRS, absDiff, abs, convertScale, 
-                              cvAnd, andMask, scaleAdd, cvAndS,
-                              cvOr, cvOrS, set, cvAbs, cvAbsDiffS,
-                              mul, mulS, add, addS, sub, subMask,
-                              cmpS, avg, avgMask, cvNot, withROI,
-                              ComparisonOp(..), isolateChannel, copy,
-                              replaceChannel, convertScaleAbs, absSat) where
+module OpenCV.ArrayOps (subRS, absDiff, abs, convertScale, 
+                        cvAnd, andMask, scaleAdd, cvAndS,
+                        cvOr, cvOrS, set, cvAbs, cvAbsDiffS,
+                        mul, mulS, add, addS, sub, subMask,
+                        cmpS, avg, avgMask, cvNot, withROI,
+                        ComparisonOp(..), isolateChannel, copy,
+                        replaceChannel, convertScaleAbs, absSat) where
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
@@ -15,11 +15,11 @@ import Foreign.Marshal.Array
 import Foreign.Marshal.Alloc
 import Foreign.Storable (poke, peek)
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), CvScalar(..),
-                                 cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
-import AI.CV.OpenCV.Core.StorableUtil
+import OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), CvScalar(..),
+                           cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
+import OpenCV.Core.StorableUtil
 
 type M = Monochromatic
 
diff --git a/src/OpenCV/ColorConversion.hs b/src/OpenCV/ColorConversion.hs
index 07dcf09..57feeea 100644
--- a/src/OpenCV/ColorConversion.hs
+++ b/src/OpenCV/ColorConversion.hs
@@ -1,14 +1,14 @@
 {-# LANGUAGE FlexibleContexts #-}
 -- |Type-safe color conversion functions. 
-module AI.CV.OpenCV.ColorConversion
+module OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
      convertBGRToGray, convertRGBToGray,
      convertBayerBgToBGR, convertBayerBgToRGB,
      convertRGBToHSV, convertBGRToHSV, convertHSVToBGR) where
-import AI.CV.OpenCV.Core.CV
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.ColorConversion
-import AI.CV.OpenCV.Core.CVOp
+import OpenCV.Core.CV
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.ColorConversion
+import OpenCV.Core.CVOp
 
 type M = Monochromatic
 type T = Trichromatic
diff --git a/src/OpenCV/Contours.hsc b/src/OpenCV/Contours.hsc
index aad156f..9ea6346 100644
--- a/src/OpenCV/Contours.hsc
+++ b/src/OpenCV/Contours.hsc
@@ -1,8 +1,8 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 -- |Incomplete support for cvFindContours.
-module AI.CV.OpenCV.Contours (ContourMode(..), ContourMethod(..), 
-                              cvFindContours, followContourList) where
-import AI.CV.OpenCV.Core.CxCore
+module OpenCV.Contours (ContourMode(..), ContourMethod(..), 
+                        cvFindContours, followContourList) where
+import OpenCV.Core.CxCore
 import Foreign.C.Types (CInt)
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Foreign.Storable
diff --git a/src/OpenCV/Core/CV.hsc b/src/OpenCV/Core/CV.hsc
index f881a6f..c0cedd5 100644
--- a/src/OpenCV/Core/CV.hsc
+++ b/src/OpenCV/Core/CV.hsc
@@ -1,6 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables #-}
 -- |Support for features from the OpenCV Image Filtering library.
-module AI.CV.OpenCV.Core.CV 
+module OpenCV.Core.CV 
     ( InterpolationMethod(..),
       cvResize, cvDilate, cvErode, cvPyrDown, cvHoughLines2, 
       --CvHaarClassifierCascade, HaarDetectFlag,
@@ -16,8 +16,8 @@ import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Marshal.Array (peekArray)
 import Foreign.Storable (Storable, sizeOf)
 import Foreign.Ptr
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.ColorConversion
+import OpenCV.Core.CxCore
+import OpenCV.Core.ColorConversion
 
 #include <opencv/cv.h>
 
diff --git a/src/OpenCV/Core/CVOp.hs b/src/OpenCV/Core/CVOp.hs
index ced1e85..a754c6b 100644
--- a/src/OpenCV/Core/CVOp.hs
+++ b/src/OpenCV/Core/CVOp.hs
@@ -18,10 +18,10 @@
 -- with such an operation, must have a destination image
 -- allocated. This is cheaper than duplicating the input image as with
 -- operations wrapped by the `cv` combinator.
-module AI.CV.OpenCV.Core.CVOp (cv, Inplace(..)) where
-import AI.CV.OpenCV.Core.CxCore (IplArrayType, CvArr)
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.HIplImage
+module OpenCV.Core.CVOp (cv, Inplace(..)) where
+import OpenCV.Core.CxCore (IplArrayType, CvArr)
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.HIplImage
 import Control.Monad ((>=>), void)
 import Data.Int
 import Data.Monoid
diff --git a/src/OpenCV/Core/ColorConversion.hsc b/src/OpenCV/Core/ColorConversion.hsc
index f7fbc48..bb07d4c 100644
--- a/src/OpenCV/Core/ColorConversion.hsc
+++ b/src/OpenCV/Core/ColorConversion.hsc
@@ -1,5 +1,5 @@
 -- |Constants for color conversion
-module AI.CV.OpenCV.Core.ColorConversion where
+module OpenCV.Core.ColorConversion where
 import Foreign.C.Types (CInt)
 
 #include <opencv2/imgproc/imgproc_c.h>
diff --git a/src/OpenCV/Core/CxCore.hsc b/src/OpenCV/Core/CxCore.hsc
index 37be23a..97e7093 100644
--- a/src/OpenCV/Core/CxCore.hsc
+++ b/src/OpenCV/Core/CxCore.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
-module AI.CV.OpenCV.Core.CxCore where
+module OpenCV.Core.CxCore where
 import Control.Applicative
 import Control.Monad ((>=>))
 import Foreign.C.Types
diff --git a/src/OpenCV/Core/HIplImage.hsc b/src/OpenCV/Core/HIplImage.hsc
index e1dcb1c..f4e1037 100644
--- a/src/OpenCV/Core/HIplImage.hsc
+++ b/src/OpenCV/Core/HIplImage.hsc
@@ -2,7 +2,7 @@
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
              BangPatterns, FlexibleContexts, TypeSynonymInstances #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
-module AI.CV.OpenCV.Core.HIplImage (
+module OpenCV.Core.HIplImage (
     -- * Phantom types that statically describe image properties
     Trichromatic, Monochromatic, HasROI, NoROI,
 
@@ -18,11 +18,11 @@ module AI.CV.OpenCV.Core.HIplImage (
     c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
     widthStep, imageDataOrigin, setROI, resetROI, ImgBuilder(..)
   ) where
-import AI.CV.OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
-                                 iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
-                                 CvRect(..), CvScalar(..))
-import AI.CV.OpenCV.Core.CV (cvCvtColor)
-import AI.CV.OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
+import OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
+                           iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
+                           CvRect(..), CvScalar(..))
+import OpenCV.Core.CV (cvCvtColor)
+import OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (complement, (.&.))
diff --git a/src/OpenCV/Core/HIplUtil.hs b/src/OpenCV/Core/HIplUtil.hs
index a8866ba..b9678f2 100644
--- a/src/OpenCV/Core/HIplUtil.hs
+++ b/src/OpenCV/Core/HIplUtil.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables, BangPatterns, MultiParamTypeClasses, 
              FlexibleInstances #-}
 -- |Functions for working with 'HIplImage's.
-module AI.CV.OpenCV.Core.HIplUtil
+module OpenCV.Core.HIplUtil
     (isColor, isMono, imgChannels, withPixelVector, pixels,
      fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
@@ -14,11 +14,11 @@ module AI.CV.OpenCV.Core.HIplUtil
      HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
      ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
-import AI.CV.OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF, 
-                                 CvSize(..), cloneImageF, cvCreateImage, 
-                                 getNumChannels, getDepth, cvGetSize)
-import AI.CV.OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
-import AI.CV.OpenCV.Core.HIplImage
+import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF, 
+                           CvSize(..), cloneImageF, cvCreateImage, 
+                           getNumChannels, getDepth, cvGetSize)
+import OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
+import OpenCV.Core.HIplImage
 import Control.Applicative
 import Control.Arrow (second, (***))
 import Control.Monad (when, unless, join)
diff --git a/src/OpenCV/Core/HighGui.hsc b/src/OpenCV/Core/HighGui.hsc
index 413d04e..c31e25a 100644
--- a/src/OpenCV/Core/HighGui.hsc
+++ b/src/OpenCV/Core/HighGui.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
-module AI.CV.OpenCV.Core.HighGui 
+module OpenCV.Core.HighGui 
     (cvLoadImage, LoadColor(..), cvSaveImage, 
      CvCapture, cvCreateCameraCapture, 
      createCameraCaptureF, createFileCaptureF,
@@ -19,7 +19,7 @@ import Foreign.ForeignPtr
 import Foreign.C.String
 
 import Data.List (foldl') 
-import AI.CV.OpenCV.Core.CxCore
+import OpenCV.Core.CxCore
 
 #include <opencv2/highgui/highgui_c.h>
 
diff --git a/src/OpenCV/Core/StorableUtil.hs b/src/OpenCV/Core/StorableUtil.hs
index 081bd00..296e7b3 100644
--- a/src/OpenCV/Core/StorableUtil.hs
+++ b/src/OpenCV/Core/StorableUtil.hs
@@ -1,4 +1,4 @@
-module AI.CV.OpenCV.Core.StorableUtil where
+module OpenCV.Core.StorableUtil where
 import Foreign.Marshal.Alloc (alloca)
 import Foreign.Storable (Storable(poke))
 import Foreign.Ptr (Ptr)
diff --git a/src/OpenCV/Drawing.hsc b/src/OpenCV/Drawing.hsc
index 589f711..afeb147 100644
--- a/src/OpenCV/Drawing.hsc
+++ b/src/OpenCV/Drawing.hsc
@@ -1,10 +1,10 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
-module AI.CV.OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
-                             LineType(..), RGB, drawLines, fillConvexPoly) where
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
-import AI.CV.OpenCV.Core.StorableUtil
+module OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
+                       LineType(..), RGB, drawLines, fillConvexPoly) where
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
+import OpenCV.Core.StorableUtil
 import Data.Bits ((.|.))
 import Foreign.C.String
 import Foreign.C.Types
diff --git a/src/OpenCV/FeatureDetection.hs b/src/OpenCV/FeatureDetection.hs
index b697a4e..e16d736 100644
--- a/src/OpenCV/FeatureDetection.hs
+++ b/src/OpenCV/FeatureDetection.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE ForeignFunctionInterface, FlexibleContexts #-}
 -- |Feature Detection.
-module AI.CV.OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
+module OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
 import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvCornerHarris"
   c_cvHarris :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> CDouble -> IO ()
diff --git a/src/OpenCV/Filtering.hsc b/src/OpenCV/Filtering.hsc
index f70dd19..882486d 100644
--- a/src/OpenCV/Filtering.hsc
+++ b/src/OpenCV/Filtering.hsc
@@ -1,15 +1,15 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}
 -- |Image filtering operations.
-module AI.CV.OpenCV.Filtering (smoothGaussian, smoothGaussian', 
-                               sobel, sobelDX, sobelDY,
-                               ApertureSize(..), DerivativeOrder(..)) where
+module OpenCV.Filtering (smoothGaussian, smoothGaussian', 
+                         sobel, sobelDX, sobelDY,
+                         ApertureSize(..), DerivativeOrder(..)) where
 import Data.Word (Word8)
 import Data.Int (Int16)
 import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
 
diff --git a/src/OpenCV/FloodFill.hsc b/src/OpenCV/FloodFill.hsc
index cb2e595..d0ba9a4 100644
--- a/src/OpenCV/FloodFill.hsc
+++ b/src/OpenCV/FloodFill.hsc
@@ -1,13 +1,13 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}
 -- |Miscellaneous image transformations.
-module AI.CV.OpenCV.FloodFill (floodFill, FloodRange(..)) where
+module OpenCV.FloodFill (floodFill, FloodRange(..)) where
 import Data.Bits ((.|.))
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
-import AI.CV.OpenCV.Core.CxCore 
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
-import AI.CV.OpenCV.Core.StorableUtil
+import OpenCV.Core.CxCore 
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
+import OpenCV.Core.StorableUtil
 
 -- |Flag used to indicate whether pixels under consideration for
 -- addition to a connected component should be compared to the seed
diff --git a/src/OpenCV/GUI.hs b/src/OpenCV/GUI.hs
index 03a9271..52b3a21 100644
--- a/src/OpenCV/GUI.hs
+++ b/src/OpenCV/GUI.hs
@@ -1,10 +1,10 @@
 -- |Very simple tools for showing images in a window. The 'runWindow'
 -- and 'runNamedWindow' interfaces are the recommended entrypoints.
-module AI.CV.OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
-                         waitKey, cvInit, runWindow, runNamedWindow) where
-import AI.CV.OpenCV.Core.HIplImage
-import AI.CV.OpenCV.Core.HighGui
-import AI.CV.OpenCV.Core.CxCore (fromArr)
+module OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
+                   waitKey, cvInit, runWindow, runNamedWindow) where
+import OpenCV.Core.HIplImage
+import OpenCV.Core.HighGui
+import OpenCV.Core.CxCore (fromArr)
 import Control.Monad ((>=>))
 import Data.Bits ((.&.))
 import Data.Word (Word8)
diff --git a/src/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
index eb90e72..ac38b61 100644
--- a/src/OpenCV/HighCV.hs
+++ b/src/OpenCV/HighCV.hs
@@ -2,56 +2,56 @@
 -- operations will be performed in-place under composition. For
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
 -- than two.
-module AI.CV.OpenCV.HighCV (
-                            -- * Image Files
-                            fromFile, fromFileGray, fromFileColor, 
-                            fromPGM16, toFile,
-                            -- * Image Properties
-                            width, height, numPixels, isColor, isMono,
-                            -- * Image Construction
-                            fromPixels, fromGrayPixels, fromColorPixels, 
-                            fromPtr,
-                            -- * Image Data Accessors
-                            pixels, withPixelVector, withImagePixels, 
-                            sampleLine, getRect,
-                            -- * Image Processing
-                            erode, dilate, houghStandard, houghProbabilistic, 
-                            normalize, resize, setROI, resetROI,
-                            module AI.CV.OpenCV.ColorConversion,
-                            module AI.CV.OpenCV.Threshold,
-                            module AI.CV.OpenCV.FloodFill,
-                            module AI.CV.OpenCV.FeatureDetection,
-                            Connectivity(..), 
-                            CvRect(..), liftCvRect,
-                            cv_L2, cv_MinMax, 
-                            InterpolationMethod(..), 
-                            -- * GUI and Drawing
-                            module AI.CV.OpenCV.GUI, 
-                            module AI.CV.OpenCV.Drawing,
-                            -- * Video
-                            module AI.CV.OpenCV.Video,
-                            -- * Image types
-                            HIplImage, Monochromatic, Trichromatic, 
-                            HasChannels, HasDepth, 
-                            GrayImage, ColorImage, GrayImage16, GrayImage16S,
-                            Word8, Word16
+module OpenCV.HighCV (
+                      -- * Image Files
+                      fromFile, fromFileGray, fromFileColor, 
+                      fromPGM16, toFile,
+                      -- * Image Properties
+                      width, height, numPixels, isColor, isMono,
+                      -- * Image Construction
+                      fromPixels, fromGrayPixels, fromColorPixels, 
+                      fromPtr,
+                      -- * Image Data Accessors
+                      pixels, withPixelVector, withImagePixels, 
+                      sampleLine, getRect,
+                      -- * Image Processing
+                      erode, dilate, houghStandard, houghProbabilistic, 
+                      normalize, resize, setROI, resetROI,
+                      module OpenCV.ColorConversion,
+                      module OpenCV.Threshold,
+                      module OpenCV.FloodFill,
+                      module OpenCV.FeatureDetection,
+                      Connectivity(..), 
+                      CvRect(..), liftCvRect,
+                      cv_L2, cv_MinMax, 
+                      InterpolationMethod(..), 
+                      -- * GUI and Drawing
+                      module OpenCV.GUI, 
+                      module OpenCV.Drawing,
+                      -- * Video
+                      module OpenCV.Video,
+                      -- * Image types
+                      HIplImage, Monochromatic, Trichromatic, 
+                      HasChannels, HasDepth, 
+                      GrayImage, ColorImage, GrayImage16, GrayImage16S,
+                      Word8, Word16
     ) where
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.CV
-import AI.CV.OpenCV.Drawing
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
-import AI.CV.OpenCV.ColorConversion
+import OpenCV.Core.CxCore
+import OpenCV.Core.CV
+import OpenCV.Drawing
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
+import OpenCV.ColorConversion
 import Data.Word (Word8, Word16)
 import Foreign.C.Types (CDouble)
 import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
-import AI.CV.OpenCV.GUI
-import AI.CV.OpenCV.Threshold
-import AI.CV.OpenCV.FloodFill
-import AI.CV.OpenCV.FeatureDetection
-import AI.CV.OpenCV.Video
+import OpenCV.GUI
+import OpenCV.Threshold
+import OpenCV.FloodFill
+import OpenCV.FeatureDetection
+import OpenCV.Video
 
 -- |Erode an 'HIplImage' with a 3x3 structuring element for the
 -- specified number of iterations.
diff --git a/src/OpenCV/Histograms.hs b/src/OpenCV/Histograms.hs
index 23eab3a..d3c97bf 100644
--- a/src/OpenCV/Histograms.hs
+++ b/src/OpenCV/Histograms.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
-module AI.CV.OpenCV.Histograms (equalizeHist) where
+module OpenCV.Histograms (equalizeHist) where
 import Foreign.Ptr (Ptr)
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvEqualizeHist"
   c_cvEqualizeHist :: Ptr CvArr -> Ptr CvArr -> IO ()
diff --git a/src/OpenCV/Motion.hsc b/src/OpenCV/Motion.hsc
index 40769de..3142485 100644
--- a/src/OpenCV/Motion.hsc
+++ b/src/OpenCV/Motion.hsc
@@ -1,12 +1,12 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 -- |Motion analysis functions.
-module AI.CV.OpenCV.Motion (calcOpticalFlowBM) where
+module OpenCV.Motion (calcOpticalFlowBM) where
 import Data.Word (Word8)
 import Foreign.C.Types (CInt)
 import Foreign.Ptr (Ptr)
 import System.IO.Unsafe
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplImage
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplImage
 
 foreign import ccall "opencv2/video/tracking.hpp cvCalcOpticalFlowBM"
   c_cvCalcOpticalFlowBM :: Ptr CvArr -> Ptr CvArr -> CInt -> CInt -> 
diff --git a/src/OpenCV/PixelUtils.hs b/src/OpenCV/PixelUtils.hs
index d60577c..e497d48 100644
--- a/src/OpenCV/PixelUtils.hs
+++ b/src/OpenCV/PixelUtils.hs
@@ -3,10 +3,10 @@
 -- pixels arranged in BGR order and pad image rows with unused
 -- bytes. This module provides mechanisms to drop the unused packing
 -- bytes.
-module AI.CV.OpenCV.PixelUtils where
-import AI.CV.OpenCV.Core.HIplImage
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.ColorConversion (convertRGBToGray)
+module OpenCV.PixelUtils where
+import OpenCV.Core.HIplImage
+import OpenCV.Core.HIplUtil
+import OpenCV.ColorConversion (convertRGBToGray)
 import Control.Monad.ST (runST)
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as VM
diff --git a/src/OpenCV/Threshold.hs b/src/OpenCV/Threshold.hs
index 696d13b..e2ca4c5 100644
--- a/src/OpenCV/Threshold.hs
+++ b/src/OpenCV/Threshold.hs
@@ -2,19 +2,19 @@
              MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when used in compositions.
-module AI.CV.OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
-                               thresholdTruncate, 
-                               thresholdToZero, thresholdToZeroInv,
-                               thresholdBinaryOtsu, thresholdBinaryOtsuInv,
-                               thresholdTruncateOtsu,
-                               thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
+module OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
+                         thresholdTruncate, 
+                         thresholdToZero, thresholdToZeroInv,
+                         thresholdBinaryOtsu, thresholdBinaryOtsuInv,
+                         thresholdTruncateOtsu,
+                         thresholdToZeroOtsu, thresholdToZeroOtsuInv) where
 import Data.Bits ((.|.))
 import Data.Word (Word8)
 import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr)
-import AI.CV.OpenCV.Core.CxCore 
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.CVOp
+import OpenCV.Core.CxCore 
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.CVOp
 
 data ThresholdType = ThreshBinary
                    | ThreshBinaryInv
diff --git a/src/OpenCV/Video.hs b/src/OpenCV/Video.hs
index 1950c97..26b10e4 100644
--- a/src/OpenCV/Video.hs
+++ b/src/OpenCV/Video.hs
@@ -1,14 +1,14 @@
 -- |Interfaces for grabbing images from cameras and video files, and
 -- for writing to video files.
-module AI.CV.OpenCV.Video (createFileCapture, createFileCaptureLoop, 
-                           createCameraCapture, createVideoWriter, 
-                           FourCC, mpeg4CC) where
+module OpenCV.Video (createFileCapture, createFileCaptureLoop, 
+                     createCameraCapture, createVideoWriter, 
+                     FourCC, mpeg4CC) where
 import Data.Maybe (fromMaybe)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
-import AI.CV.OpenCV.Core.CxCore
-import AI.CV.OpenCV.Core.HIplUtil
-import AI.CV.OpenCV.Core.HighGui
+import OpenCV.Core.CxCore
+import OpenCV.Core.HIplUtil
+import OpenCV.Core.HighGui
 
 -- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
 -- returns a 'Ptr' 'IplImage'.

From 0a92981d3205379f82205dfab347f9cf9867bcd2 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Thu, 20 Sep 2012 19:40:28 -0400
Subject: [PATCH 121/137] Replaced HIplImage with Image.

This new type uses data kinds to more succinctly enforce type-level
properties of images.
---
 HOpenCV.cabal                |   9 +-
 src/OpenCV/Core/Image.hsc    | 362 +++++++++++++++++++++++++++++++++++
 src/OpenCV/Core/ImageUtil.hs | 316 ++++++++++++++++++++++++++++++
 3 files changed, 683 insertions(+), 4 deletions(-)
 create mode 100644 src/OpenCV/Core/Image.hsc
 create mode 100644 src/OpenCV/Core/ImageUtil.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index dffb275..dab653d 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -6,7 +6,7 @@ maintainer: Anthony Cowley <acowley@gmail.com>
 stability: experimental
 category: AI, Graphics
 synopsis: A binding for the OpenCV computer vision library.
-Tested-With:   GHC==7.4.1
+Tested-With:   GHC==7.6.1
 description:
    Limited bindings to OpenCV 2.4. (See: <http://opencv.willowgarage.com/wiki/Welcome>)
    .
@@ -44,8 +44,8 @@ library
       OpenCV.Core.CVOp 
       OpenCV.Core.CxCore
       OpenCV.Core.HighGui
-      OpenCV.Core.HIplImage
-      OpenCV.Core.HIplUtil
+      OpenCV.Core.Image
+      OpenCV.Core.ImageUtil
       OpenCV.Core.ColorConversion
       OpenCV.HighCV
       OpenCV.GUI
@@ -83,5 +83,6 @@ library
                   template-haskell,
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,
-                  vector >= 0.7
+                  vector >= 0.7,
+                  singletons, tagged
    ghc-options: -Wall -fno-warn-name-shadowing -O2 -funbox-strict-fields
diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc
new file mode 100644
index 0000000..6baeace
--- /dev/null
+++ b/src/OpenCV/Core/Image.hsc
@@ -0,0 +1,362 @@
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
+             TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
+             BangPatterns, FlexibleContexts, TypeSynonymInstances,
+             DataKinds, TemplateHaskell #-}
+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-unused-binds #-}
+module OpenCV.Core.Image (
+    -- * Phantom types that statically describe image properties
+    Channels(..), ROIEnabled(..),
+
+    -- * Value-level reification of type-level properties
+    HasDepth(..), 
+
+    -- * Typed support for image operations that take scalar (color) parameters
+    CvScalarT, AsCvScalar(..),
+
+    -- * Low-level image data structure
+    Image(..), mkImage, mallocImage, blackImage, blackoutPixels, 
+    withIplImage, bytesPerPixel, numChannels, peekIpl, pokeIpl,
+    freeROI, c_cvSetImageROI, c_cvResetImageROI, setROI, resetROI, imageHasROI,
+    UpdateROI(..)
+  ) where
+import OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
+                           iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
+                           CvRect(..), CvScalar(..))
+import OpenCV.Core.CV (cvCvtColor)
+import OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
+import Control.Applicative ((<$>))
+import Control.Monad (when)
+import Data.Bits (complement, (.&.))
+import Data.Int
+import Data.Proxy
+import Data.Singletons
+import Data.Word (Word8, Word16)
+import Foreign.C.Types
+import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Array (allocaArray, peekArray)
+import Foreign.Ptr
+import Foreign.Storable
+import Unsafe.Coerce
+
+#include <opencv2/core/types_c.h>
+{-
+typedef struct _IplImage
+{
+    int  nSize;
+    int  ID;
+    int  nChannels;
+    int  alphaChannel;
+    int  depth;
+    char colorModel[4];
+    char channelSeq[4];
+    int  dataOrder;
+    int  origin;
+    int  align;
+    int  width;
+    int  height;
+    struct _IplROI *roi;
+    struct _IplImage *maskROI;
+    void  *imageId;
+    struct _IplTileInfo *tileInfo;
+    int  imageSize;
+    char *imageData;
+    int  widthStep;
+    int  BorderMode[4];
+    int  BorderConst[4];
+    char *imageDataOrigin;
+}
+IplImage;
+-}
+
+-- *Phantom types that statically describe image properties
+data Channels = Trichromatic | Monochromatic
+data ROIEnabled = HasROI | NoROI
+
+genSingletons [''Channels, ''ROIEnabled]
+
+-- NOTE: The singletons library defines various things for us that we
+-- don't explicitly pattern match on or export, leading GHC to issue
+-- unused binding warnings. We disable those warnings for this file.
+
+numChannels' :: Channels -> Int
+numChannels' Trichromatic = 3
+numChannels' Monochromatic = 1
+
+-- |Extract number of channels from the singleton value associated
+-- with a type of the 'Channels' kind.
+numChannels :: forall c. SingI c => Proxy (c::Channels) -> Int
+numChannels _ = numChannels' . fromSing $ (sing::Sing c)
+
+hasROI :: forall r. SingI r => Proxy (r::ROIEnabled) -> Bool
+hasROI _ = case fromSing (sing::Sing r) of
+             HasROI -> True
+             _ -> False
+
+imageHasROI :: forall c d r. SingI r => Image c d r -> Bool
+imageHasROI _ = case fromSing (sing::Sing r) of
+                  HasROI -> True
+                  _ -> False
+
+class (Storable a, Num a) => HasDepth a where
+    depth      :: a -> Depth
+    toDouble   :: a -> Double
+    fromDouble :: Double -> a
+
+instance HasDepth Word8 where 
+    depth _ = iplDepth8u
+    toDouble = fromIntegral
+    fromDouble = round
+instance HasDepth Word16 where 
+    depth _ = iplDepth16u
+    toDouble = fromIntegral
+    fromDouble = round
+instance HasDepth Int16 where 
+    depth _ = iplDepth16s
+    toDouble = fromIntegral
+    fromDouble = round
+instance HasDepth Float where 
+    depth _ = iplDepth32f
+    toDouble = realToFrac
+    fromDouble = realToFrac
+instance HasDepth Double where 
+    depth _ = iplDepth64f
+    toDouble = id
+    fromDouble = id
+
+-- |An image with a particular number of channels have an associated
+-- scalar type built from the type of its pixels. This class lets us
+-- ensure that a scalar value to be used in an operation with an image
+-- is compatible with that image.
+type family CvScalarT (c::Channels) d :: *
+type instance CvScalarT Monochromatic d = d
+type instance CvScalarT Trichromatic d = (d,d,d)
+
+-- |Scalar types are often round-tripped via doubles in OpenCV to
+-- allow for non-overloaded interfaces of functions with scalar
+-- parameters.
+class AsCvScalar x where
+    toCvScalar :: x -> CvScalar
+    fromCvScalar :: CvScalar -> x
+
+instance AsCvScalar Word8 where
+    toCvScalar = depthToScalar
+    fromCvScalar (CvScalar r _ _ _) = floor r
+
+instance AsCvScalar Word16 where
+    toCvScalar = depthToScalar
+    fromCvScalar (CvScalar r _ _ _) = floor r
+
+instance AsCvScalar Int16 where
+    toCvScalar = depthToScalar
+    fromCvScalar (CvScalar r _ _ _) = floor r
+
+instance AsCvScalar Float where
+    toCvScalar = depthToScalar
+    fromCvScalar (CvScalar r _ _ _) = realToFrac r
+
+instance AsCvScalar Double where
+    toCvScalar = depthToScalar
+    fromCvScalar (CvScalar r _ _ _) = realToFrac r
+
+instance (HasDepth d, AsCvScalar d) => AsCvScalar (d,d,d) where
+    toCvScalar (r,g,b) = let f = realToFrac . toDouble
+                         in CvScalar (f r) (f g) (f b) 0
+    fromCvScalar (CvScalar r g b _) = let f = fromDouble . realToFrac 
+                                      in (f r, f g, f b)
+
+depthToScalar :: HasDepth d => d -> CvScalar
+depthToScalar x = let x' = realToFrac (toDouble x)
+                  in CvScalar x' x' x' x'
+
+bytesPerPixel :: HasDepth d => d -> Int
+bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
+    where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
+
+-- |A data structure representing the information OpenCV uses from an
+-- 'IplImage' struct. It includes the pixel origin, image width, image
+-- height, image size (number of bytes), a pointer to the pixel data,
+-- and the row stride. Its type is parameterized by the number of
+-- color channels (i.e. 'Monochromatic' or 'Trichromatic'), the pixel
+-- depth (e.g. 'Word8', 'Float'), and whether or not the image has a
+-- region-of-interest (ROI) set ('HasROI' or 'NoROI').
+data Image (c::Channels) d (r::ROIEnabled) where
+  Image :: (SingI c, HasDepth d, SingI r) => 
+           { origin :: !CInt
+           , width :: !CInt
+           , height :: !CInt
+           , roi :: !(Maybe CvRect)
+           , imageSize :: !CInt
+           , imageData :: !(ForeignPtr d)
+           , imageDataOrigin :: !(ForeignPtr d)
+           , widthStep :: !CInt
+           } -> Image c d r
+
+
+-- |@mkImage w h ptr@ makes an 'Image' of width, @w@, and height, @h@,
+-- using pixel data at @ptr@. Pixels are assumed to be continuous, and
+-- starting at the given pointer.
+mkImage :: forall a c d. (Integral a, SingI c, HasDepth d) => 
+           a -> a -> ForeignPtr d -> Image c d NoROI
+mkImage w h pixels = Image 0 (fromIntegral w) (fromIntegral h) 
+                           Nothing (fromIntegral h*stride) pixels pixels stride
+  where stride = fromIntegral $
+                 fromIntegral w * numChannels (Proxy::Proxy c) * bytesPerPixel (undefined::d)
+
+-- |Set an image's region-of-interest.
+setROI :: CvRect -> Image c d r -> Image c d HasROI
+setROI r (Image o w h _ sz d ido ws) = Image o w h (Just r) sz d ido ws
+{-# INLINE setROI #-}
+
+-- |Clear any region-of-interest set for an image.
+resetROI :: forall c d r. Image c d r -> Image c d NoROI
+resetROI x@(Image o w h _ sz d ido ws)
+  | hasROI (Proxy::Proxy r) = Image o w h Nothing sz d ido ws
+  | otherwise = unsafeCoerce x
+{-# INLINE resetROI #-}
+
+-- |Prepare an 'Image' of the given width and height. The pixel and
+-- color depths are gleaned from the type, and may often be inferred.
+mallocImage :: forall a c d. (SingI c, HasDepth d, Integral a) => 
+               a -> a -> IO (Image c d NoROI)
+mallocImage w h = mkImage w h <$> mallocForeignPtrArray (fromIntegral numBytes)
+  where numBytes = fromIntegral (w * h) * 
+                   numChannels (Proxy::Proxy c) * bytesPerPixel (undefined::d)
+
+foreign import ccall "memset"
+  memset :: Ptr Word8 -> Word8 -> CInt -> IO ()
+
+-- |Set an all of an 'Image'\'s pixels to black.
+blackoutPixels :: Image c d r -> IO (Image c d r)
+blackoutPixels img = do withForeignPtr (imageData img) $ \ptr ->
+                          memset (castPtr ptr) 0 (fromIntegral $ imageSize img)
+                        return img
+
+-- |Prepare an 'Image' of the given width and height with all pixels
+-- set to zero.
+blackImage :: (SingI c, HasDepth d, Integral a) => 
+              a -> a -> IO (Image c d NoROI)
+blackImage w h = mallocImage w h >>= blackoutPixels
+
+foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
+  c_cvSetImageROI :: Ptr IplImage -> CInt -> CInt -> CInt -> CInt -> IO ()
+
+foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
+  c_cvResetImageROI :: Ptr IplImage -> IO ()
+
+withROI :: Image c d r -> Ptr IplImage -> (Ptr IplImage -> IO a) -> IO a
+withROI img p f = case roi img of
+                    Nothing -> f p
+                    Just (CvRect x y w h) -> do c_cvSetImageROI p x y w h
+                                                r <- f p
+                                                c_cvResetImageROI p
+                                                return r
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying the given 'Image'.
+withIplImage :: Image c d r -> (Ptr IplImage -> IO b) -> IO b
+withIplImage img@(Image{}) f = alloca $ \p ->
+                               withForeignPtr (imageData img) 
+                                              (\hp -> do pokeIpl img p (castPtr hp)
+                                                         withROI img p f)
+
+-- |Read a 'Image' from a 'Ptr' 'IplImage'
+peekIpl :: (SingI c, HasDepth d, SingI r, UpdateROI r) => 
+           Ptr IplImage -> IO (Image c d r)
+peekIpl = peek . castPtr
+
+-- Poke a 'Ptr' 'IplImage' with a specific imageData 'Ptr' that is
+-- currently valid. This is solely an auxiliary function to
+-- 'withHIplImage'.
+pokeIpl :: forall c d r. (SingI c, HasDepth d) => 
+           Image (c::Channels) d r -> Ptr IplImage -> Ptr Word8 -> IO ()
+pokeIpl himg ptr hp =
+    do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
+       (#poke IplImage, ID) ptr (0::Int)
+       (#poke IplImage, nChannels) ptr (numChannels (Proxy::Proxy c))
+       (#poke IplImage, depth) ptr (unDepth (depth (undefined::d)))
+       (#poke IplImage, dataOrder) ptr (0::Int)
+       (#poke IplImage, origin) ptr (origin himg)
+       (#poke IplImage, align) ptr (4::Int)
+       (#poke IplImage, width) ptr (width himg)
+       (#poke IplImage, height) ptr (height himg)
+       (#poke IplImage, roi) ptr nullPtr
+       (#poke IplImage, maskROI) ptr nullPtr
+       (#poke IplImage, imageId) ptr nullPtr
+       (#poke IplImage, tileInfo) ptr nullPtr
+       (#poke IplImage, imageSize) ptr (imageSize himg)
+       (#poke IplImage, imageData) ptr hp
+       (#poke IplImage, widthStep) ptr (widthStep himg)
+       (#poke IplImage, imageDataOrigin) ptr hp
+
+
+foreign import ccall "HOpenCV_wrap.h c_cvGetROI"
+  c_cvGetImageROI :: Ptr IplImage -> Ptr CInt -> IO ()
+
+freeROI :: Ptr IplImage -> IO ()
+freeROI ptr = do p <- (#peek IplImage, roi) ptr
+                 if (ptrToIntPtr p == 0) then return () else cvFree p
+
+maybePeekROI :: Ptr IplImage -> Ptr () -> IO (Maybe CvRect)
+maybePeekROI img p | p == nullPtr = return Nothing
+                   | otherwise = allocaArray 4 $ 
+                                 \r -> do c_cvGetImageROI img r
+                                          [x,y,w,h] <- peekArray 4 r
+                                          return . Just $ CvRect x y w h
+
+-- |An internal class that makes runtime guarantees about type level
+-- ROI assertions.
+class UpdateROI (a::ROIEnabled) where
+  updateROI :: Maybe CvRect -> Image c d a -> Image c d b
+
+-- These functions are runtime checks that type-level guarantees are
+-- met.
+instance UpdateROI NoROI where
+  updateROI Nothing x = unsafeCoerce $ resetROI x
+  updateROI _ _ = error "Tried to update the ROI of a NoROI Image"
+
+instance UpdateROI HasROI where
+  updateROI (Just r) x = unsafeCoerce $ setROI r x
+  updateROI _ _ = error "Tried to null out the ROI of a HasROI Image"
+
+-- |An 'Image' in Haskell conforms closely to OpenCV's 'IplImage'
+-- structure type. Note that obtaining an 'Image' from an 'IplImage'
+-- via 'peek' will not install a Haskell finalizer on the underlying
+-- pixel data. That data is the responsibility of the provider of the
+-- 'IplImage'. 'Image' values constructed within the Haskell runtime,
+-- on the other hand, will have their underlying pixel data buffers
+-- managed by the garbage collector.
+instance forall c d r. (SingI c, HasDepth d, SingI r, UpdateROI r) => 
+         Storable (Image c d r) where
+    sizeOf _ = (#size IplImage)
+    alignment _ = alignment (undefined :: CDouble)
+    poke = error "Poking a 'Ptr Image' is unsafe."
+    peek ptr = do
+      numChannels' <- (#peek IplImage, nChannels) ptr :: IO CInt
+      depth' <- Depth <$> (#peek IplImage, depth) ptr
+      width' <- (#peek IplImage, width) ptr
+      height' <- (#peek IplImage, height) ptr
+      roir <- (#peek IplImage, roi) ptr >>= maybePeekROI (castPtr ptr)
+      when (depth' /= (depth (undefined::d)))
+           (error $ "IplImage has depth "++show depth'++
+                    " but desired Image has depth "++
+                    show (depth (undefined::d)))
+      if numChannels (Proxy::Proxy c) /= fromIntegral numChannels'
+        then do img2' <- mallocImage width' height' :: IO (Image c d NoROI)
+                let img2 = updateROI roir img2' :: Image c d r
+                let conv = if numChannels' == 1 
+                           then cv_GRAY2BGR
+                           else cv_BGR2GRAY
+                    ptr' = castPtr ptr :: Ptr IplImage
+                withIplImage img2 $ \dst -> cvCvtColor (castPtr ptr') 
+                                                       (castPtr dst) 
+                                                       conv
+                (#peek IplImage, imageDataOrigin) ptr >>= cvFree
+                return $ unsafeCoerce img2
+        else do origin' <- (#peek IplImage, origin) ptr
+                imageSize' <- (#peek IplImage, imageSize) ptr
+                imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
+                imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
+                widthStep' <- (#peek IplImage, widthStep) ptr
+                return $ Image origin' width' height' roir imageSize'
+                               imageData' imageDataOrigin' widthStep'
diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
new file mode 100644
index 0000000..82b5162
--- /dev/null
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -0,0 +1,316 @@
+{-# LANGUAGE ScopedTypeVariables, BangPatterns, MultiParamTypeClasses, 
+             FlexibleInstances, DataKinds, KindSignatures #-}
+-- |Functions for working with 'HIplImage's.
+module OpenCV.Core.ImageUtil
+    (isColor, isMono, imgChannels, withPixelVector, pixels,
+     peekIpl, fromFileColor, fromFileGray, fromPGM16, toFile, 
+     compatibleImage, duplicateImage, fromPixels,
+     withImagePixels, fromGrayPixels, fromColorPixels,
+     withDuplicateImage, withCompatibleImage, setROI, resetROI,
+     mkImage, width, height, numPixels, blackImage, Image, 
+     ROIEnabled(..), withIplImage, Channels(..), 
+     GrayImage, GrayImage16, GrayImage16S, ColorImage, 
+     c_cvSetImageROI, c_cvResetImageROI,
+     HasDepth(..), CvScalarT, AsCvScalar(..), colorDepth,
+     ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
+     duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
+import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF,
+                           cloneImageF, cvCreateImage, CvSize(..),
+                           getNumChannels, getDepth, cvGetSize)
+import OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
+import OpenCV.Core.Image
+import Control.Applicative
+import Control.Arrow (second, (***))
+import Control.Monad (when, unless, join)
+import Data.Int (Int16)
+import Data.Proxy
+import qualified Data.Vector.Storable as V
+import Data.Singletons (SingI)
+import Data.Word (Word8, Word16)
+import Foreign.ForeignPtr
+import Foreign.Marshal.Utils (copyBytes)
+import Foreign.Ptr
+import Foreign.Storable
+import System.Directory (doesFileExist)
+import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode, 
+                  IOMode(..))
+import System.IO.Unsafe
+
+-- |Some operations are restricted to bytes or floats.
+class (HasDepth a, Num a) => ByteOrFloat a where
+instance ByteOrFloat Word8 where
+instance ByteOrFloat Float where
+
+-- |Grayscale 8-bit (per-pixel) image type.
+type GrayImage = Image Monochromatic Word8 NoROI
+
+-- |Grayscale unsigned 16-bit (per-pixel) image type.
+type GrayImage16 = Image Monochromatic Word16 NoROI
+
+-- |Grayscale signed 16-bit (per-pixel) image type.
+type GrayImage16S = Image Monochromatic Int16 NoROI
+
+-- |Color 8-bit (per-color) image type.
+type ColorImage = Image Trichromatic Word8 NoROI
+
+-- |This is a way to let the type checker know that you belieave an
+-- image to be tri-chromatic. If your image type can't be inferred any
+-- other way, this is an alternative to adding a type annotation.
+isColor :: Image Trichromatic d r -> Image Trichromatic d r
+isColor = id
+
+-- |This is a way to let the type checker know that you believe an
+-- image to be monochromatic. If your image type can't be inferred any
+-- other way, this is an alternative to adding a type annotation.
+isMono :: Image Monochromatic d r -> Image Monochromatic d r
+isMono = id
+
+{-# INLINE isMono #-}
+{-# INLINE isColor #-}
+
+-- |Return the number of color channels a 'HIplImage' has as a runtime
+-- value.
+imgChannels :: forall c d r. Image c d r -> Int
+imgChannels Image{} = fromIntegral $ numChannels (Proxy::Proxy c)
+
+-- |Return the number of bytes per pixel color component of an
+-- 'HIplImage'.
+colorDepth :: forall c d r. Image c d r -> Int
+colorDepth Image{} = bytesPerPixel (undefined::d)
+
+-- |The number of pixels in the image: @width img * height img@.
+numPixels :: Image c d r -> Int
+numPixels = fromIntegral . ((*) <$> width <*> height)
+
+-- |Apply the supplied function to a 'V.Vector' containing the pixels
+-- that make up an 'HIplImage'. This does not copy the underlying
+-- data.
+withImagePixels :: Image c d NoROI -> (V.Vector d -> r) -> r
+withImagePixels img@Image{} f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
+    where n = fromIntegral (imageSize img) `div` colorDepth img
+
+-- |Return a 'V.Vector' containing a copy of the pixels that make up a
+-- 'HIplImage'.
+pixels :: Storable d => Image c d NoROI -> V.Vector d
+pixels img = unsafePerformIO $ 
+             do ptr <- mallocForeignPtrBytes len
+                withForeignPtr ptr $ \dst -> 
+                    withForeignPtr (imageData img) $ \src -> 
+                        copyBytes dst src len
+                return $ V.unsafeFromForeignPtr ptr 0 len
+    where len = fromIntegral $ imageSize img
+{-# NOINLINE pixels #-}
+
+
+-- Ensure that a file exists.
+checkFile :: FilePath -> IO ()
+checkFile f = do e <- doesFileExist f
+                 unless e (error $ "Can't find "++f)
+
+-- |Load a color 'HIplImage' from an 8-bit image file. If the image
+-- file is grayscale, it will be converted to color.
+fromFileColor :: FilePath -> IO (Image Trichromatic Word8 NoROI)
+fromFileColor fileName = 
+  do checkFile fileName
+     ptr <- cvLoadImage fileName LoadColor
+     img <- peekIpl ptr :: IO (Image Trichromatic Word8 NoROI)
+     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
+     freeROI ptr
+     cvFree ptr
+     return img
+
+-- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
+-- image file is color, it will be converted to grayscale.
+fromFileGray :: FilePath -> IO (Image Monochromatic Word8 NoROI)
+fromFileGray fileName = 
+  do checkFile fileName
+     ptr <- cvLoadImage fileName LoadGray
+     img <- peekIpl ptr :: IO (Image Monochromatic Word8 NoROI)
+     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
+     return img
+
+-- |If the type of a loaded image is known (e.g. by a type annotation,
+-- or usage of a narrowly typed functions), then we can automatically
+-- dispatch to the proper image loading routine.
+class LoadableFormat (c::Channels) d where
+  loadFormat :: (Proxy c,d) -> FilePath -> IO (Image c d NoROI)
+
+instance LoadableFormat Monochromatic Word8 where
+  loadFormat _ = fromFileGray
+
+instance LoadableFormat Trichromatic Word8 where
+  loadFormat _ = fromFileColor
+
+instance LoadableFormat Monochromatic Word16 where
+  loadFormat _ = fromPGM16
+
+-- |An overloaded image file loader. The number of color channels and
+-- color depth parts of the returned image's type must be inferrable
+-- as they control how the image file is loaded.
+fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (Image c d NoROI)
+fromFile = loadFormat (Proxy::Proxy c, undefined::d)
+
+-- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
+-- OpenCV (as of v2.2) does not correctly handle 16-bit PGM loading,
+-- so this 16bpp loader is restricted to PGM. This loading routine
+-- converts from Most Significant Byte first (MSB) byte ordering (as
+-- per the PGM spec) to LSB byte ordering for x86 compatibility.
+fromPGM16 :: FilePath -> IO (Image Monochromatic Word16 NoROI)
+fromPGM16 fileName = 
+  do checkFile fileName
+     h <- openFile fileName ReadMode
+     magic <- hGetLine h
+     when (magic /= "P5") (hClose h >> 
+                           error (fileName ++" is not a PGM"))
+     (width, height) <- fmap ((read***read). second tail . break (==' '))
+                             (hGetLine h) :: IO (Int,Int)
+     maxCol <- hGetLine h
+     when (maxCol /= "65535") (hClose h >>
+                               error (fileName ++" is not 16-bit"))
+     let numBytes = fromIntegral $ width*height*2
+     fp <- mallocForeignPtrArray numBytes
+     hSetBinaryMode h True
+     withForeignPtr fp $ \ptr' ->
+       do let ptr = castPtr ptr' :: Ptr Word8
+          n <- hGetBuf h ptr numBytes
+          when (n /= numBytes) (hClose h >> 
+                                error (fileName ++" unexpected EOF"))
+          let swapBytes !offset
+                | offset == numBytes = return ()
+                | otherwise = do temp1 <- peekByteOff ptr offset :: IO Word8
+                                 temp2 <- peekByteOff ptr (offset+1) :: IO Word8
+                                 pokeByteOff ptr offset temp2
+                                 pokeByteOff ptr (offset+1) temp1
+                                 swapBytes (offset+2)
+          swapBytes 0
+     hClose h
+     return $ mkImage width height fp
+
+-- |Save an image to the specified file.
+toFile :: HasDepth d => FilePath -> Image c d r -> IO ()
+toFile fileName img = withIplImage img $ \ptr -> cvSaveImage fileName ptr
+
+-- |Allocate a new 'Image' with the same dimensions, number of color
+-- channels, and color depth as an existing 'Image'. The pixel data of
+-- the original 'Image' is not copied.
+compatibleImage :: Image c d r -> IO (Image c d r)
+compatibleImage img@Image{} = updateROI (roi img) <$> 
+                              mallocImage (width img) (height img)
+
+-- |Allocate a new 'IplImage' with the same dimensions, number of
+-- color channels, and color depth as an existing 'HIplImage'. The
+-- pixel data of the original 'HIplImage' is not copied.
+compatibleImagePtr :: forall c d r. Image c d r -> IO (ForeignPtr IplImage)
+compatibleImagePtr img@Image{} = createImageF (CvSize w' h') nc d
+    where w' = fromIntegral . width $ img
+          h' = fromIntegral . height $ img
+          nc = fromIntegral . imgChannels $ img
+          d = depth (undefined::d)
+
+compatibleImagePtrPtr :: Ptr IplImage -> IO (Ptr IplImage)
+compatibleImagePtrPtr = 
+    join . (liftA3 cvCreateImage <$> cvGetSize <*> getNumChannels <*> getDepth)
+
+-- |Create an exact duplicate of the given 'Image'. This allocates a
+-- fresh array to store the copied pixels.
+duplicateImage :: Image c d r -> IO (Image c d r)
+duplicateImage img@Image{} = 
+  do img' <- updateROI (roi img) <$> mallocImage (width img) (height img)
+     withForeignPtr (imageData img) $ \src ->
+       withForeignPtr (imageData img') $ \dst ->
+         copyBytes dst src (fromIntegral $ imageSize img)
+     return img'
+
+-- |Clone an 'Image', returning the 'Ptr' 'IplImage' underlying
+-- the clone.
+duplicateImagePtr :: Image c d r -> IO (ForeignPtr IplImage)
+duplicateImagePtr = flip withIplImage cloneImageF
+
+-- |Pass the given function an 'Image' constructed from a width, a
+-- height, and a 'V.Vector' of pixel values. The new 'Image'\'s pixel
+-- data is shared with the supplied 'V.Vector'. In other words, this
+-- lets the user apply a function on 'Image's to a 'V.Vector' of pixel
+-- data.
+withPixelVector :: forall a c d r. (HasDepth d, Integral a, SingI c) =>
+                   a -> a -> V.Vector d -> (Image c d NoROI -> r) -> r
+withPixelVector w h pix f = if len == sz
+                            then f $ mkImage w h fp
+                            else error "Length disagreement"
+    where sz = fromIntegral (w * h) * numChannels (Proxy::Proxy c)
+          (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
+                         (fp,0,len) -> (fp,len)
+                         _ -> error "fromPixels non-zero offset"
+
+-- |Construct a fresh 'Image' from a width, a height, and a 'V.Vector'
+-- of pixel values. The returned 'Image' shares the underlying
+-- 'V.Vector'\'s data.
+fromPixels :: forall a c d. (Integral a, SingI c, HasDepth d) =>
+              a -> a -> V.Vector d -> Image c d NoROI
+fromPixels w h pix = unsafePerformIO $ 
+                     do fp <- copyData
+                        return $ mkImage w h fp
+    where copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
+                     in do fp <- mallocForeignPtrBytes len
+                           withForeignPtr vfp $ \src -> 
+                             withForeignPtr fp $ \dst -> 
+                               let src' = plusPtr src offset
+                               in copyBytes dst src' len
+                           return fp
+{-# INLINE [0] fromPixels #-}
+
+-- |Helper function to explicitly type a vector of monochromatic pixel
+-- data. Parameters are the output image's width, height, and pixel
+-- content.
+fromGrayPixels :: (HasDepth d, Integral a) => 
+                  a -> a -> V.Vector d -> Image Monochromatic d NoROI
+fromGrayPixels w h = isMono . fromPixels w h
+
+-- |Helper function to explicitly type a vector of interleaved
+-- trichromatic pixel data. Parameters are the output image's width,
+-- height, and pixel content.
+fromColorPixels :: (HasDepth d, Integral a) =>
+                   a -> a -> V.Vector d -> Image Trichromatic d NoROI
+fromColorPixels w h = isColor . fromPixels w h
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'Image' that is an exact duplicate of the given
+-- 'Image'. Returns the duplicate 'Image' after performing the given
+-- action along with the result of that action.
+withDuplicateImage :: Image c d r -> (Ptr IplImage -> IO b) -> 
+                      IO (Image c d r, b)
+withDuplicateImage img1 f = do img2 <- duplicateImage img1
+                               r <- withIplImage img2 f
+                               return (img2, r)
+
+-- |Provides the supplied function with a 'Ptr' to the 'IplImage'
+-- underlying a new 'Image' of the same dimensions as the given
+-- 'Image'.
+withCompatibleImage :: Image c d r -> (Ptr IplImage -> IO b) -> 
+                       IO (Image c d r, b)
+withCompatibleImage img1 f = do img2 <- compatibleImage img1
+                                r <- withIplImage img2 f
+                                return (img2, r)
+
+unsafeWithHIplImage :: Image c d r -> (Ptr IplImage -> a) -> a
+unsafeWithHIplImage img f = unsafePerformIO $ withIplImage img (return . f)
+
+-- |Extract a rectangular region of interest from an image. Returns a
+-- new image whose pixel data is copied from the given rectangle of
+-- the source image. Parameters are the upper-left corner of the
+-- rectangle in image coordinates, the (width,height) of the rectangle
+-- in pixels, and the source 'Image'.
+getRect :: forall c d r. 
+           (Int,Int) -> (Int,Int) -> Image c d r -> IO (Image c d NoROI)
+getRect (rx,ry) (rw,rh) src@Image{} = 
+    do img <- mallocImage rw rh :: IO (Image c d NoROI)
+       withForeignPtr (imageData img) $ \dst ->
+         withForeignPtr (imageData src) $ \src ->
+           mapM_ (\(dOff, sOff) -> copyBytes (plusPtr dst dOff) 
+                                             (plusPtr src sOff)
+                                             rowLen)
+                 (zip [0,rowLen..rw*rh*bpp-1] [start,start+stride..])
+       return img
+    where stride = fromIntegral $ widthStep src
+          start = stride*ry + rx*bpp
+          bpp = imgChannels src * colorDepth src
+          rowLen = rw*bpp

From d195556c73dca9cf8e73b76971528378f10bcb31 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Thu, 20 Sep 2012 21:14:34 -0400
Subject: [PATCH 122/137] Switched over to DataKinds and new Image type.

Some code is simplified with the new Image type, and we admit fewer
absurd types with tighter kinds.
---
 src/OpenCV/ArrayOps.hsc        | 188 +++++++---------
 src/OpenCV/ColorConversion.hs  |  27 ++-
 src/OpenCV/Core/CVOp.hs        | 137 +++++-------
 src/OpenCV/Core/CxCore.hsc     |  45 ++--
 src/OpenCV/Core/HIplImage.hsc  | 395 ---------------------------------
 src/OpenCV/Core/HIplUtil.hs    | 335 ----------------------------
 src/OpenCV/Core/Image.hsc      |  10 +-
 src/OpenCV/Core/ImageUtil.hs   |   7 +-
 src/OpenCV/Drawing.hsc         |  25 +--
 src/OpenCV/FeatureDetection.hs |  18 +-
 src/OpenCV/Filtering.hsc       |  31 ++-
 src/OpenCV/FloodFill.hsc       |  15 +-
 src/OpenCV/GUI.hs              |  18 +-
 src/OpenCV/HighCV.hs           |  59 +++--
 src/OpenCV/Histograms.hs       |   2 +-
 src/OpenCV/PixelUtils.hs       |  25 +--
 src/OpenCV/Threshold.hs        |  60 ++---
 src/OpenCV/Video.hs            |  27 +--
 18 files changed, 322 insertions(+), 1102 deletions(-)
 delete mode 100644 src/OpenCV/Core/HIplImage.hsc
 delete mode 100644 src/OpenCV/Core/HIplUtil.hs

diff --git a/src/OpenCV/ArrayOps.hsc b/src/OpenCV/ArrayOps.hsc
index 5d1477a..bb35873 100644
--- a/src/OpenCV/ArrayOps.hsc
+++ b/src/OpenCV/ArrayOps.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeFamilies, ScopedTypeVariables,
-             FlexibleContexts #-}
+             FlexibleContexts, DataKinds, ConstraintKinds #-}
 -- |Array operations.
 module OpenCV.ArrayOps (subRS, absDiff, abs, convertScale, 
                         cvAnd, andMask, scaleAdd, cvAndS,
@@ -17,7 +17,7 @@ import Foreign.Storable (poke, peek)
 import System.IO.Unsafe (unsafePerformIO)
 import OpenCV.Core.CxCore (CvArr, CvRect(..), CmpOp(..), CvScalar(..),
                            cmpEq, cmpGT, cmpGE, cmpLT, cmpLE, cmpNE)
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 import OpenCV.Core.StorableUtil
 
@@ -35,9 +35,8 @@ foreign import ccall "" -- "static ArrayOps_hsc.h c_cvSubRS"
                Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |@subRS value src@ computes @value - src[i]@ for every pixel.
-subRS :: (HasChannels c, HasDepth d, HasScalar c d, 
-          IsCvScalar s, s ~ CvScalarT c d, Inplace r c d c d) =>
-         s -> HIplImage c d r -> HIplImage c d r
+subRS :: (HasDepth d, ScalarOK s c d, Inplace r c d c d) =>
+         s -> Image c d r -> Image c d r
 subRS value = cv2 $ \src dst -> 
               withS (toCvScalar value) $ \sPtr ->
                 c_cvSubRS src sPtr dst nullPtr
@@ -47,10 +46,10 @@ foreign import ccall "opencv2/core/core_c.h cvAbsDiff"
   c_cvAbsDiff :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Calculate the absolute difference between two images.
-absDiff :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
-           HIplImage c d r -> HIplImage c d r -> HIplImage c d r
+absDiff :: (HasDepth d, Inplace r c d c d) => 
+           Image c d r -> Image c d r -> Image c d r
 absDiff src1 = cv2 $ \src2 dst -> 
-               withHIplImage src1 $ \src1' ->
+               withIplImage src1 $ \src1' ->
                  c_cvAbsDiff (castPtr src1') src2 dst
 {-# INLINE absDiff #-}
 
@@ -65,17 +64,15 @@ foreign import ccall ""
   c_cvAbsDiffS :: Ptr CvArr -> Ptr CvArr -> Ptr CvScalar -> IO ()
 
 -- |Absolute difference of each pixel in an image and a scalar.
-cvAbsDiffS :: (HasChannels c, HasDepth d, Inplace r c d c d,
-               IsCvScalar s, s ~ CvScalarT c d) =>
-              s -> HIplImage c d r -> HIplImage c d r
+cvAbsDiffS :: (HasDepth d, Inplace r c d c d, ScalarOK s c d) =>
+              s -> Image c d r -> Image c d r
 cvAbsDiffS value = cv2 $ \src dst -> 
                    withS (toCvScalar value) $ \vPtr ->
                      c_cvAbsDiffS src dst vPtr
 {-# INLINE cvAbsDiffS #-}
 
 -- |Absolute value of each pixel.
-cvAbs :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
-         HIplImage c d r -> HIplImage c d r
+cvAbs :: (HasDepth d, Inplace r c d c d) => Image c d r -> Image c d r
 cvAbs = cv2 $ \src dst -> 
         withS (CvScalar 0 0 0 0) $ \sPtr -> 
           c_cvAbsDiffS src dst sPtr
@@ -90,11 +87,9 @@ foreign import ccall "opencv2/core/core_c.h cvConvertScale"
 -- converted to the destination type with rounding and saturation. All
 -- the channels of multi-channel arrays are processed
 -- independentally. Parameters are @scale@, @shift@, and the source
--- 'HIplImage'.
-convertScale :: (HasChannels c, HasDepth d1, HasDepth d2, ImgBuilder r,
-                 Inplace r c d1 c d2) =>
-                Double -> Double -> HIplImage c d1 r -> 
-                HIplImage c d2 r
+-- 'Image'.
+convertScale :: (HasDepth d1, HasDepth d2, Inplace r c d1 c d2) =>
+                Double -> Double -> Image c d1 r -> Image c d2 r
 convertScale scale shift = cv2 $ \src dst -> 
                            c_cvConvertScale src dst (rf scale) (rf shift)
   where rf = realToFrac
@@ -106,15 +101,15 @@ foreign import ccall "opencv2/core/core_c.h cvConvertScaleAbs"
 -- |@convertScaleAbs scale shift@ scales each element of an image,
 -- adds an offset to the scaled value, computes the absolute value,
 -- and saturates to 8 bits.
-convertScaleAbs :: (HasChannels c, HasDepth d, Inplace r c d c Word8) =>
-                   CDouble -> CDouble -> HIplImage c d r -> HIplImage c Word8 r
+convertScaleAbs :: (HasDepth d, Inplace r c d c Word8) =>
+                   CDouble -> CDouble -> Image c d r -> Image c Word8 r
 convertScaleAbs scale shift = cv2 $ \src dst -> 
                               c_cvConvertScaleAbs src dst scale shift
 {-# INLINE convertScaleAbs #-}
 
 -- |Computes the absolute value of each pixel and saturates to 8 bits.
-absSat :: (HasChannels c, HasDepth d, Inplace r c d c Word8) =>
-          HIplImage c d r -> HIplImage c Word8 r
+absSat :: (HasDepth d, Inplace r c d c Word8) =>
+          Image c d r -> Image c Word8 r
 absSat = convertScaleAbs 1 0
 {-# INLINE absSat #-}
 
@@ -126,20 +121,19 @@ foreign import ccall "opencv2/core/core_c.h cvAnd"
 -- specifies the elements of the result that will be computed via the
 -- conjunction, and those that will simply be copied from the third
 -- parameter.
-andMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
-            Inplace r3 c d c d) => 
-           HIplImage Monochromatic Word8 r1 -> HIplImage c d r2 ->  
-           HIplImage c d r3 -> HIplImage c d r3
+andMask :: (HasDepth d, Inplace r3 c d c d) => 
+           Image Monochromatic Word8 r1 -> Image c d r2 ->  
+           Image c d r3 -> Image c d r3
 andMask mask src1 = cv2 $ \src2 dst -> 
-                    withHIplImage src1 $ \src1' -> 
-                        withHIplImage mask $ \mask' ->
+                    withIplImage src1 $ \src1' -> 
+                        withIplImage mask $ \mask' ->
                             c_cvAnd (castPtr src1') src2 dst (castPtr mask')
 {-# INLINE andMask #-}
 
 -- |Calculates the per-element bitwise conjunction of two arrays.
-cvAnd :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
-          HIplImage c d r1 -> HIplImage c d r2 ->  HIplImage c d r2
-cvAnd src1 = cv2 $ \src2 dst -> withHIplImage src1 $ \src1' -> 
+cvAnd :: (HasDepth d, Inplace r2 c d c d) => 
+          Image c d r1 -> Image c d r2 ->  Image c d r2
+cvAnd src1 = cv2 $ \src2 dst -> withIplImage src1 $ \src1' -> 
              c_cvAnd (castPtr src1') src2 dst nullPtr
 {-# INLINE cvAnd #-}
 
@@ -153,9 +147,8 @@ foreign import ccall ""
 
 
 -- |Per-element bit-wise conjunction of an array and a scalar. 
-cvAndS :: (HasChannels c, HasDepth d, HasScalar c d, IsCvScalar s, 
-           s ~ CvScalarT c d, Inplace r c d c d) => 
-          s -> HIplImage c d r -> HIplImage c d r
+cvAndS :: (HasDepth d, ScalarOK s c d, Inplace r c d c d) => 
+          s -> Image c d r -> Image c d r
 cvAndS s = cv2 $ \img dst -> 
            withS (toCvScalar s) $ \sPtr ->
              c_cvAndS img sPtr dst nullPtr
@@ -175,12 +168,10 @@ foreign import ccall ""
 
 -- |Calculate the sum of a scaled array and another array. @scaleAdd
 -- src1 s src2@ computes @dst[i] = s*src1[i] + src2[i]@
-scaleAdd :: (HasScalar c d, HasDepth d, HasChannels c, 
-             s ~ CvScalarT c d, IsCvScalar s, ImgBuilder r1, 
-             Inplace r2 c d c d) => 
-            HIplImage c d r1 -> s -> HIplImage c d r2 -> HIplImage c d r2
+scaleAdd :: (ScalarOK s c d, HasDepth d, Inplace r2 c d c d) => 
+            Image c d r1 -> s -> Image c d r2 -> Image c d r2
 scaleAdd src1 s = cv2 $ \src2 dst ->
-                  withHIplImage src1 $ \src1' ->
+                  withIplImage src1 $ \src1' ->
                   withS (toCvScalar s) $ \sPtr ->
                     c_cvScaleAdd (castPtr src1') sPtr src2 dst
 {-# INLINE scaleAdd #-}
@@ -192,19 +183,19 @@ cvMulHelper :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Double -> IO ()
 cvMulHelper src1 src2 dst s = c_cvMul src1 src2 dst (realToFrac s)
 
 -- |Per-element product of two arrays.
-mul :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
-       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+mul :: (HasDepth d, Inplace r2 c d c d) => 
+       Image c d r1 -> Image c d r2 -> Image c d r2
 mul src1 = cv2 $ \src2 dst -> 
-           withHIplImage src1 $ \src1' ->
+           withIplImage src1 $ \src1' ->
                cvMulHelper (castPtr src1') src2 dst 1
 {-# INLINE mul #-}
 
 -- |Per-element product of two arrays with an extra scale factor that
 -- is multiplied with each product.
-mulS :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) => 
-        Double -> HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+mulS :: (HasDepth d, Inplace r2 c d c d) => 
+        Double -> Image c d r1 -> Image c d r2 -> Image c d r2
 mulS scale src1 = cv2 $ \src2 dst ->
-                  withHIplImage src1 $ \src1' ->
+                  withIplImage src1 $ \src1' ->
                       cvMulHelper (castPtr src1') src2 dst scale
 {-# INLINE mulS #-}
 
@@ -212,11 +203,10 @@ foreign import ccall "opencv2/core/core_c.h cvAdd"
   c_cvAdd :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element sum.
-add :: (HasChannels c, HasDepth d1, HasDepth d2, HasDepth d3,
-        ImgBuilder r1, Inplace r2 c d2 c d3) => 
-       HIplImage c d1 r1 -> HIplImage c d2 r2 -> HIplImage c d3 r2
+add :: (HasDepth d1, HasDepth d2, HasDepth d3, Inplace r2 c d2 c d3) => 
+       Image c d1 r1 -> Image c d2 r2 -> Image c d3 r2
 add src1 = cv2 $ \src2 dst ->
-           withHIplImage src1 $ \src1' ->
+           withIplImage src1 $ \src1' ->
                c_cvAdd (castPtr src1') src2 dst nullPtr
 {-# INLINE add #-}
 
@@ -232,9 +222,8 @@ foreign import ccall ""
   c_cvAddS :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Computes the sum of an array and a scalar.
-addS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
-         Inplace r c d c d) => 
-        s -> HIplImage c d r -> HIplImage c d r
+addS :: (HasDepth d, ScalarOK s c d, Inplace r c d c d) => 
+        s -> Image c d r -> Image c d r
 addS scalar = cv2 $ \src dst -> 
               withS (toCvScalar scalar) $ \sPtr ->
                 c_cvAddS src sPtr dst nullPtr
@@ -244,10 +233,10 @@ foreign import ccall "opencv2/core/core_c.h cvSub"
   c_cvSub :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element difference.
-sub :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) =>
-       HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+sub :: (HasDepth d, Inplace r2 c d c d) =>
+       Image c d r1 -> Image c d r2 -> Image c d r2
 sub img1 = cv2 $ \img2 dst ->
-           withHIplImage img1 $ \img1' -> 
+           withIplImage img1 $ \img1' -> 
                c_cvSub (castPtr img1') img2 dst nullPtr
 {-# INLINE sub #-}
 
@@ -255,13 +244,12 @@ sub img1 = cv2 $ \img2 dst ->
 -- img1@ computes @dst[i] = img1[i] - img2[i] if mask[i]@. The idea is
 -- that @dst@ is the same as @img1@ everywhere @mask@ is zero. This
 -- permits in-place updating of @img1@.
-subMask :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, 
-            Inplace r3 c d c d) =>
-           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> HIplImage c d r3 -> 
-           HIplImage c d r3
+subMask :: (HasDepth d, Inplace r3 c d c d, UpdateROI r3) =>
+           Image c d r1 -> Image Monochromatic Word8 r2 -> Image c d r3 -> 
+           Image c d r3
 subMask img2 mask = cv $ \img1 ->
-                    withHIplImage mask $ \mask' -> 
-                        withHIplImage img2 $ \img2' ->
+                    withIplImage mask $ \mask' -> 
+                        withIplImage img2 $ \img2' ->
                             c_cvSub img1 (castPtr img2') img1 (castPtr mask')
 {-# INLINE subMask #-}
 
@@ -269,10 +257,10 @@ foreign import ccall "opencv2/core/core_c.h cvOr"
   c_cvOr :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise disjunction of two arrays
-cvOr :: (HasChannels c, HasDepth d, ImgBuilder r1, Inplace r2 c d c d) =>
-        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
+cvOr :: (HasDepth d, Inplace r2 c d c d) =>
+        Image c d r1 -> Image c d r2 -> Image c d r2
 cvOr img1 = cv2 $ \img2 dst ->
-            withHIplImage img1 $ \img1' -> 
+            withIplImage img1 $ \img1' -> 
                 c_cvOr (castPtr img1') img2 dst nullPtr
 {-# INLINE cvOr #-}
 
@@ -289,9 +277,8 @@ foreign import ccall ""
 
 
 -- |Per-element bit-wise disjunction of an array and a scalar.
-cvOrS :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
-          Inplace r c d c d) => 
-         s -> HIplImage c d r -> HIplImage c d r
+cvOrS :: (HasDepth d, ScalarOK s c d, Inplace r c d c d) => 
+         s -> Image c d r -> Image c d r
 cvOrS scalar = cv2 $ \src dst -> 
                withS (toCvScalar scalar) $ \sPtr ->
                  c_cvOrS src sPtr dst nullPtr
@@ -308,30 +295,27 @@ foreign import ccall ""
   c_cvSet :: Ptr CvArr -> Ptr CvScalar -> Ptr CvArr -> IO ()
 
 -- |Set every element of an array to a given value.
-set :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
-        Inplace r c d c d) => 
-       s -> HIplImage c d r -> HIplImage c d r
-set scalar = cv $ \src -> 
-             withS (toCvScalar scalar) $ \sPtr ->
-               c_cvSet src sPtr nullPtr
+set :: (HasDepth d, ScalarOK s c d, Inplace r c d c d) => 
+       s -> Image c d r -> Image c d r
+set scalar img@Image{} = flip cv img $ \src -> 
+                         withS (toCvScalar scalar) $ \sPtr ->
+                           c_cvSet src sPtr nullPtr 
 {-# INLINE set #-}
 
-setROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
-            CvRect -> HIplImage c d r -> HIplImage c d HasROI
+setROICV :: forall c d r. HasDepth d => 
+            CvRect -> Image c d r -> Image c d HasROI
 setROICV (CvRect x y w h) = cv $ \img -> c_cvSetImageROI img x y w h
 {-# INLINE setROICV #-}
 
-resetROICV :: forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
-              HIplImage c d r -> HIplImage c d NoROI
+resetROICV :: forall c d r. HasDepth d => Image c d r -> Image c d NoROI
 resetROICV = cv $ \img -> c_cvResetImageROI img
 {-# INLINE resetROICV #-}
 
 -- |Restrict an operation to a specific region-of-interest. This
 -- operation fuses.
-withROI :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-            ImgBuilder r, ImgBuilder r2) => 
-           CvRect -> (HIplImage c1 d1 HasROI -> HIplImage c2 d2 r2) -> 
-           HIplImage c1 d1 r -> HIplImage c2 d2 NoROI
+withROI :: (HasDepth d1, HasDepth d2) => 
+           CvRect -> (Image c1 d1 HasROI -> Image c2 d2 r2) -> 
+           Image c1 d1 r -> Image c2 d2 NoROI
 withROI r f = resetROICV . f . setROICV r
 {-# INLINE withROI #-}
 
@@ -350,8 +334,8 @@ cmpToCmp CmpNE = unCmpOp cmpNE
 
 -- |Per-element comparison of an array and a scalar.
 cmpS :: (HasDepth d, Inplace r M d M Word8) => 
-        ComparisonOp -> d -> HIplImage Monochromatic d r -> 
-        HIplImage Monochromatic Word8 r
+        ComparisonOp -> d -> Image Monochromatic d r -> 
+        Image Monochromatic Word8 r
 cmpS op v = cv2 $ \src dst ->
             c_cvCmpS src v' dst (cmpToCmp op)
     where v' = realToFrac . toDouble $ v
@@ -360,7 +344,7 @@ cmpS op v = cv2 $ \src dst ->
 foreign import ccall "HOpenCV_wrap.h c_cvAvg"
   c_cvAvg :: Ptr CvArr -> Ptr CvArr -> Ptr CvScalar -> IO ()
 
-avgWorker :: IsCvScalar b => Ptr CvArr -> Ptr CvArr -> IO b
+avgWorker :: AsCvScalar b => Ptr CvArr -> Ptr CvArr -> IO b
 avgWorker img mask = alloca $ \ptr ->
                      c_cvAvg img mask ptr >> fromCvScalar `fmap` peek ptr
 -- avgWorker img mask = allocaArray 4 $ 
@@ -370,28 +354,25 @@ avgWorker img mask = alloca $ \ptr ->
 --                                 -- return $ fromCvScalar (r,g,b,a)
 
 -- |Calculates the mean independently for each channel.
-avg :: (HasChannels c, HasDepth d, IsCvScalar s, 
-        s ~ CvScalarT c d, ImgBuilder r) => 
-       HIplImage c d r -> CvScalarT c d
-avg img = unsafePerformIO . withHIplImage img $ flip avgWorker nullPtr . castPtr
+avg :: (HasDepth d, ScalarOK s c d) => Image c d r -> CvScalarT c d
+avg img = unsafePerformIO . withIplImage img $ flip avgWorker nullPtr . castPtr
 {-# NOINLINE avg #-}
 
 -- |@avgMask img mask@ calculates the mean independently for each
 -- channel for each element of the source array whose entry in @mask@
 -- is non-zero.
-avgMask :: (HasChannels c, HasDepth d, IsCvScalar s, s ~ CvScalarT c d, 
-            ImgBuilder r1, ImgBuilder r2) => 
-           HIplImage c d r1 -> HIplImage Monochromatic Word8 r2 -> CvScalarT c d
-avgMask img mask = unsafePerformIO . withHIplImage img $ \src ->
-                   withHIplImage mask $ avgWorker (castPtr src) . castPtr
+avgMask :: (HasDepth d, ScalarOK s c d) => 
+           Image c d r1 -> Image Monochromatic Word8 r2 -> CvScalarT c d
+avgMask img mask = unsafePerformIO . withIplImage img $ \src ->
+                   withIplImage mask $ avgWorker (castPtr src) . castPtr
 {-# NOINLINE avgMask #-}
 
 foreign import ccall "opencv2/core/core_c.h cvNot"
   c_cvNot :: Ptr CvArr -> Ptr CvArr -> IO ()
 
 -- |Per-element bit-wise inversion.
-cvNot :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
-         HIplImage c d r -> HIplImage c d r
+cvNot :: (HasDepth d, Inplace r c d c d) => 
+         Image c d r -> Image c d r
 cvNot = cv2 $ \src dst -> c_cvNot src dst
 {-# INLINE cvNot #-}
 
@@ -401,7 +382,7 @@ foreign import ccall "opencv2/core/core_c.h cvMixChannels"
 
 -- |Isolate a specific channel from a trichromatic image.
 isolateChannel :: (HasDepth d, Inplace r Trichromatic d M d) =>
-                  CInt -> HIplImage Trichromatic d r -> HIplImage Monochromatic d r
+                  CInt -> Image Trichromatic d r -> Image Monochromatic d r
 isolateChannel n = cv2 $ \src dst -> 
                    alloca $ \p1 -> poke p1 src >>
                                    (alloca $ \p2 ->
@@ -412,12 +393,11 @@ isolateChannel n = cv2 $ \src dst ->
 
 -- |Replace a specific channel of a trichromatic image with the single
 -- channel from a monochromatic image.
-replaceChannel :: (HasDepth d, ImgBuilder r1, 
-                   Inplace r2 Trichromatic d Trichromatic d) => 
-                  CInt -> HIplImage Monochromatic d r1 -> 
-                  HIplImage Trichromatic d r2 -> HIplImage Trichromatic d r2
+replaceChannel :: (HasDepth d, Inplace r2 Trichromatic d Trichromatic d) => 
+                  CInt -> Image Monochromatic d r1 -> 
+                  Image Trichromatic d r2 -> Image Trichromatic d r2
 replaceChannel n c = cv2 $ \src dst -> 
-                     withHIplImage c $ \cp ->
+                     withIplImage c $ \cp ->
                        withArray [castPtr cp, src] $ \p1 -> 
                          withArray [dst] $ \p2 ->
                            withArray [0,n,1+n',n',1+n'',n''] $ \ft ->
@@ -429,8 +409,8 @@ replaceChannel n c = cv2 $ \src dst ->
 foreign import ccall "opencv2/core/core_c.h cvCopy"
   cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
 
-copy :: (HasChannels c, HasDepth d, ImgBuilder r2) =>
-        HIplImage c d r1 -> HIplImage c d r2 -> HIplImage c d r2
-copy src = cv $ \dst -> withHIplImage src $ \src' ->
+copy :: (UpdateROI r2, HasDepth d) => 
+        Image c d r1 -> Image c d r2 -> Image c d r2
+copy src = cv $ \dst -> withIplImage src $ \src' ->
            cvCopy (castPtr src') dst nullPtr
 {-# INLINE copy #-}
diff --git a/src/OpenCV/ColorConversion.hs b/src/OpenCV/ColorConversion.hs
index 57feeea..e7e26eb 100644
--- a/src/OpenCV/ColorConversion.hs
+++ b/src/OpenCV/ColorConversion.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, DataKinds #-}
 -- |Type-safe color conversion functions. 
 module OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
@@ -6,7 +6,7 @@ module OpenCV.ColorConversion
      convertBayerBgToBGR, convertBayerBgToRGB,
      convertRGBToHSV, convertBGRToHSV, convertHSVToBGR) where
 import OpenCV.Core.CV
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.ColorConversion
 import OpenCV.Core.CVOp
 
@@ -14,53 +14,52 @@ type M = Monochromatic
 type T = Trichromatic
 
 convertGrayToRGB :: (HasDepth d, Inplace r M d T d) =>
-                    HIplImage Monochromatic d r -> HIplImage Trichromatic d r
+                    Image Monochromatic d r -> Image Trichromatic d r
 convertGrayToRGB = convertColor cv_GRAY2RGB
 {-# INLINE convertGrayToRGB #-}
 
 convertGrayToBGR :: (HasDepth d, Inplace r M d T d) =>
-                    HIplImage Monochromatic d r -> HIplImage Trichromatic d r
+                    Image Monochromatic d r -> Image Trichromatic d r
 convertGrayToBGR = convertColor cv_GRAY2BGR
 {-# INLINE convertGrayToBGR #-}
 
 convertBGRToGray :: (HasDepth d, Inplace r T d M d) =>
-                    HIplImage Trichromatic d r -> HIplImage Monochromatic d r
+                    Image Trichromatic d r -> Image Monochromatic d r
 convertBGRToGray = convertColor cv_BGR2GRAY
 {-# INLINE convertBGRToGray #-}
 
 convertRGBToGray :: (HasDepth d, Inplace r T d M d) =>
-                    HIplImage Trichromatic d r -> HIplImage Monochromatic d r
+                    Image Trichromatic d r -> Image Monochromatic d r
 convertRGBToGray = convertBGRToGray
 {-# INLINE convertRGBToGray #-}
 
 convertBayerBgToBGR :: (HasDepth d, Inplace r M d T d) =>
-                       HIplImage Monochromatic d r -> HIplImage Trichromatic d r
+                       Image Monochromatic d r -> Image Trichromatic d r
 convertBayerBgToBGR = convertColor cv_BayerBG2BGR
 {-# INLINE convertBayerBgToBGR #-}
 
 convertBayerBgToRGB :: (HasDepth d, Inplace r M d T d) =>
-                       HIplImage Monochromatic d r -> HIplImage Trichromatic d r
+                       Image Monochromatic d r -> Image Trichromatic d r
 convertBayerBgToRGB = convertColor cv_BayerBG2RGB
 {-# INLINE convertBayerBgToRGB #-}
 
 convertRGBToHSV :: (HasDepth d, Inplace r T d T d) =>
-                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
+                   Image Trichromatic d r -> Image Trichromatic d r
 convertRGBToHSV = convertColor cv_RGB2HSV
 {-# INLINE convertRGBToHSV #-}
 
 convertBGRToHSV :: (HasDepth d, Inplace r T d T d) =>
-                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
+                   Image Trichromatic d r -> Image Trichromatic d r
 convertBGRToHSV = convertColor cv_BGR2HSV
 {-# INLINE convertBGRToHSV #-}
 
 convertHSVToBGR :: (HasDepth d, Inplace r T d T d) =>
-                   HIplImage Trichromatic d r -> HIplImage Trichromatic d r
+                   Image Trichromatic d r -> Image Trichromatic d r
 convertHSVToBGR = convertColor cv_HSV2BGR
 {-# INLINE convertHSVToBGR #-}
 
 -- |Convert the color model of an image.
-convertColor :: (HasChannels c1, HasChannels c2, HasDepth d, 
-                 Inplace r c1 d c2 d) =>
-                ColorConversion -> HIplImage c1 d r -> HIplImage c2 d r
+convertColor :: (HasDepth d, Inplace r c1 d c2 d) =>
+                ColorConversion -> Image c1 d r -> Image c2 d r
 convertColor cc = cv2 $ \src dst -> cvCvtColor src dst cc
 {-# INLINE convertColor #-}
\ No newline at end of file
diff --git a/src/OpenCV/Core/CVOp.hs b/src/OpenCV/Core/CVOp.hs
index a754c6b..518917c 100644
--- a/src/OpenCV/Core/CVOp.hs
+++ b/src/OpenCV/Core/CVOp.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances,
-             TypeSynonymInstances, CPP #-}
+             TypeSynonymInstances, CPP, DataKinds, KindSignatures, GADTs #-}
 -- |Combinators that fuse compositions of image processing operations
 -- for in-place mutation.
 --
@@ -20,9 +20,9 @@
 -- operations wrapped by the `cv` combinator.
 module OpenCV.Core.CVOp (cv, Inplace(..)) where
 import OpenCV.Core.CxCore (IplArrayType, CvArr)
-import OpenCV.Core.HIplUtil
-import OpenCV.Core.HIplImage
-import Control.Monad ((>=>), void)
+import OpenCV.Core.ImageUtil
+import OpenCV.Core.Image
+import Control.Monad (void)
 import Data.Int
 import Data.Monoid
 import Foreign.ForeignPtr
@@ -30,16 +30,17 @@ import Foreign.Ptr
 import System.IO.Unsafe
 import Data.Word (Word8, Word16)
 
--- |A CV operation is an IO function on a 'HIplImage'.
-newtype CVOp c d = CVOp { op :: Ptr CvArr -> IO () }
+-- |A CV operation is an IO function on a 'Image'.
+newtype CVOp (c::Channels) d = CVOp { op :: Ptr CvArr -> IO () }
 
 -- |A wrapper for operations that mutate an array in-place. The input
 -- to such operations must be duplicated before being passed to the
 -- operation.
 cv :: forall a c d e r1 r2.
-      (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2, IplArrayType e) => 
-      (Ptr e -> IO a) -> HIplImage c d r1 -> HIplImage c d r2
-cv = runCV . mkCVOp
+      (HasDepth d, IplArrayType e, UpdateROI r2) => 
+      (Ptr e -> IO a) -> Image c d r1 -> Image c d r2
+--cv = runCV . mkCVOp
+cv f img@Image{} = runCV (mkCVOp f) img
     where mkCVOp :: (Ptr e -> IO a) -> CVOp c d
           mkCVOp f = CVOp (void . f. castPtr)
 {-# INLINE cv #-}
@@ -49,14 +50,13 @@ instance Monoid (CVOp c d) where
   CVOp f `mappend` CVOp g = CVOp (\x -> g x >> f x)
   {-# INLINE mappend #-}
 
-withClone :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2) =>
-             (Ptr e -> IO a) -> HIplImage c d r1 -> IO (HIplImage c d r2)
-withClone f = duplicateImagePtr >=> flip withForeignPtr (\x -> f (castPtr x) >> 
-                                                               fromPtr x)
+withClone :: UpdateROI r2 => 
+             (Ptr e -> IO a) -> Image c d r1 -> IO (Image c d r2)
+withClone f img@Image{} = duplicateImagePtr img >>= 
+                          flip withForeignPtr (\x -> f (castPtr x) >> peekIpl x)
 
 -- |Run a 'CVOp'.
-runCV :: (HasChannels c, HasDepth d, ImgBuilder r1, ImgBuilder r2) => 
-         CVOp c d -> HIplImage c d r1 -> HIplImage c d r2
+runCV :: UpdateROI r2 => CVOp c d -> Image c d r1 -> Image c d r2
 runCV = (unsafeDupablePerformIO .) . withClone . op
 {-# NOINLINE runCV #-}
 
@@ -66,27 +66,19 @@ dupArg f = \x -> f x x
 
 -- |Wrapper for operations that want an argument /and/ a compatible
 -- destination buffer, but don't need a clone of an input.
-cv2Alloc :: forall a c1 d1 c2 d2 e r.
-            (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-             IplArrayType e, ImgBuilder r) => 
-            (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
+cv2Alloc :: forall a c1 d1 c2 d2 e r. (HasDepth d1, HasDepth d2, SingI c2) =>
+            (Ptr e -> Ptr e -> IO a) -> Image c1 d1 r -> Image c2 d2 r
 cv2Alloc = runBinOp . mkBinOp
-    where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp (c1,d1) (c2,d2)
+    where mkBinOp :: (Ptr e -> Ptr e -> IO a) -> BinOp c1 d1 c2 d2
           mkBinOp f = BinOp (\x y -> void (f (castPtr x) (castPtr y)))
 {-# INLINE cv2Alloc #-}
 
-bi2unary :: BinOp (c,d) (c,d) -> CVOp c d
+bi2unary :: BinOp c d c d -> CVOp c d
 bi2unary = CVOp . dupArg . binop
 
-unary2bi :: CVOp c d -> BinOp (c,d) (c,d)
+unary2bi :: CVOp c d -> BinOp c d c d
 unary2bi = BinOp . const . op
 
-#ifdef MAX_VERSION_base(4,4,0)
-(<>) :: Monoid m => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}
-#endif
-
 -- |Some operations benefit from operating in-place over a defined
 -- region-of-interest (ROI). If an operation must recompute every
 -- pixel of the result image, then there is no need to initialize a
@@ -95,17 +87,17 @@ unary2bi = BinOp . const . op
 -- image, then the result image should be initialized as a copy of the
 -- source image so that its contents outside the ROI match the
 -- original image.
-class (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) =>
-      Inplace r c1 d1 c2 d2 where
+class (HasDepth d1, HasDepth d2, SingI c2) => 
+      Inplace (r::ROIEnabled) (c1::Channels) d1 (c2::Channels) d2 where
   cv2 :: IplArrayType e =>
-           (Ptr e -> Ptr e -> IO a) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
+           (Ptr e -> Ptr e -> IO a) -> Image c1 d1 r -> Image c2 d2 r
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 -- | We clone an image and operate within its ROI if the source and
 -- destination images are compatible (same number of channels and
 -- pixel depth).
-instance (HasChannels c, HasDepth d) => Inplace HasROI c d c d where
+instance (c1~c2, HasDepth d, SingI c2) => Inplace HasROI c1 d c2 d where
   cv2 = cv . dupArg
   {-# INLINE cv2 #-}
 
@@ -119,100 +111,79 @@ instance (HasDepth d1, HasDepth d2) =>
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word8 c2 Float where
+instance SingI c2 => Inplace HasROI c1 Word8 c2 Float where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word8 c2 Word16 where
+instance SingI c2 => Inplace HasROI c1 Word8 c2 Word16 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word8 c2 Double where
+instance SingI c2 => Inplace HasROI c1 Word8 c2 Double where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word16 c2 Word8 where
+instance SingI c2 => Inplace HasROI c1 Word16 c2 Word8 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Float c2 Word8 where
+instance SingI c2 => Inplace HasROI c1 Float c2 Word8 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
-instance (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2) =>
-         Inplace NoROI c1 d1 c2 d2 where
+instance (HasDepth d1, HasDepth d2, SingI c2) => Inplace NoROI c1 d1 c2 d2 where
   cv2 = cv2Alloc
   {-# INLINE cv2 #-}
 
 -- If the source and destination are not compatible, then it doesn't
 -- matter if there is a ROI set as we can never operate in-place.
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word8 c2 Int16 where
+instance SingI c2 => Inplace HasROI c1 Word8 c2 Int16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Float c2 Word16 where
+instance SingI c2 => Inplace HasROI c1 Float c2 Word16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Float c2 Int16 where
+instance SingI c2 => Inplace HasROI c1 Float c2 Int16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Float c2 Double where
+instance SingI c2 => Inplace HasROI c1 Float c2 Double where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word16 c2 Int16 where
+instance SingI c2 => Inplace HasROI c1 Word16 c2 Int16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word16 c2 Float where
+instance SingI c2 => Inplace HasROI c1 Word16 c2 Float where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Word16 c2 Double where
+instance SingI c2 => Inplace HasROI c1 Word16 c2 Double where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Double c2 Float where
+instance SingI c2 => Inplace HasROI c1 Double c2 Float where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Double c2 Word16 where
+instance SingI c2 => Inplace HasROI c1 Double c2 Word16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Double c2 Word8 where
+instance SingI c2 => Inplace HasROI c1 Double c2 Word8 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Double c2 Int16 where
+instance SingI c2 => Inplace HasROI c1 Double c2 Int16 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Int16 c2 Word8 where
+instance SingI c2 => Inplace HasROI c1 Int16 c2 Word8 where
 
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Int16 c2 Word16 where
+instance SingI c2 => Inplace HasROI c1 Int16 c2 Word16 where
 
 -- |This can be in-place due to the common representation.
-instance (HasChannels c1, HasChannels c2) => 
-         Inplace HasROI c1 Int16 c2 Float where
+instance SingI c2 => Inplace HasROI c1 Int16 c2 Float where
 
-newtype BinOp a b = 
+newtype BinOp (c1::Channels) d1 (c2::Channels) d2 = 
     BinOp { binop :: Ptr CvArr -> Ptr CvArr -> IO () }
 
 -- Compose 'BinOp's for in-place mutation when the types allow it.
-cbop :: BinOp b b -> BinOp a b -> BinOp a b
+cbop :: BinOp c d c d -> BinOp c0 d0 c d -> BinOp c0 d0 c d
 cbop (BinOp f) (BinOp g) = BinOp $ \x y -> g x y >> f y y
 
-withDst :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, 
-            ImgBuilder r, IplArrayType e) => 
+withDst :: (HasDepth d1, HasDepth d2, IplArrayType e, SingI c2) => 
            (Ptr e -> Ptr e -> IO a) ->
-           HIplImage c1 d1 r -> IO (HIplImage c2 d2 r)
-withDst f img = do img2' <- mkHIplImage (width img) (height img)
-                   let img2 = addMaybeROI (roi img) img2'
-                   _ <- withHIplImage img2 go
+           Image c1 d1 r -> IO (Image c2 d2 r)
+withDst f img = do img2' <- mallocImage (width img) (height img)
+                   let img2 = updateROI (roi img) img2'
+                   _ <- withIplImage img2 go
                    return img2
-    where go x = withHIplImage img (flip f (castPtr x) . castPtr)
+    where go x = withIplImage img (flip f (castPtr x) . castPtr)
 
-runBinOp :: (HasChannels c1, HasDepth d1, HasChannels c2, HasDepth d2, ImgBuilder r) => 
-            BinOp (c1,d1) (c2,d2) -> HIplImage c1 d1 r -> HIplImage c2 d2 r
+runBinOp :: (HasDepth d1, HasDepth d2, SingI c2) => 
+            BinOp c1 d1 c2 d2 -> Image c1 d1 r -> Image c2 d2 r
 runBinOp = (unsafeDupablePerformIO .) . withDst . binop
 {-# NOINLINE runBinOp #-}
 
diff --git a/src/OpenCV/Core/CxCore.hsc b/src/OpenCV/Core/CxCore.hsc
index 97e7093..f12f17e 100644
--- a/src/OpenCV/Core/CxCore.hsc
+++ b/src/OpenCV/Core/CxCore.hsc
@@ -36,22 +36,26 @@ instance Storable CvSize where
         (#poke CvSize, width) ptr w
         (#poke CvSize, height) ptr h
 
-liftCvSize ::(RealFrac c, Num b) => (b -> c) -> CvSize -> CvSize
-liftCvSize f (CvSize w h) = CvSize (f' w) (f' h)
-    where f' = toFromIntegral f
-
-liftCvSize2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvSize -> CvSize -> CvSize
-liftCvSize2 f (CvSize w1 h1) (CvSize w2 h2) = CvSize (f' w1 w2) (f' h1 h2)
-    where f' = toFromIntegral2 f
+--liftCvSize ::(RealFrac c, Num b) => (b -> c) -> CvSize -> CvSize
+--liftCvSize f (CvSize w h) = CvSize (f' w) (f' h)
+--     where f' = toFromIntegral f
+liftCvSize :: (CInt -> CInt) -> CvSize -> CvSize
+liftCvSize f (CvSize w h) = CvSize (f w) (f h)
+
+-- liftCvSize2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvSize -> CvSize -> CvSize
+-- liftCvSize2 f (CvSize w1 h1) (CvSize w2 h2) = CvSize (f' w1 w2) (f' h1 h2)
+--     where f' = toFromIntegral2 f
+liftCvSize2 :: (CInt -> CInt -> CInt) -> CvSize -> CvSize -> CvSize
+liftCvSize2 f (CvSize w1 h1) (CvSize w2 h2) = CvSize (f w1 w2) (f h1 h2)
 
 instance AdditiveGroup CvSize where
   zeroV = CvSize 0 0
   (^+^) = liftCvSize2 (+)
-  negateV = liftCvSize (0-)
+  negateV = liftCvSize (0 -)
 
 instance VectorSpace CvSize where
   type Scalar CvSize = Double -- todo: use CInt instead of Double here?
-  a *^ s = liftCvSize (a*) s
+  a *^ s = liftCvSize (floor . (a*) . fromIntegral) s
 
 data CvRect  = CvRect { rectX      :: {-# UNPACK #-} !CInt
                       , rectY      :: {-# UNPACK #-} !CInt
@@ -75,22 +79,27 @@ instance Storable CvRect where
         (#poke CvRect, height) ptr h
 
 -- |Apply a function to each component of a 'CvRect'.
-liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect
-liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h)
-    where f' = toFromIntegral f
-
-liftCvRect2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvRect -> CvRect -> CvRect
-liftCvRect2 f (CvRect x1 y1 w1 h1) (CvRect x2 y2 w2 h2) = CvRect (f' x1 x2) (f' y1 y2) (f' w1 w2) (f' h1 h2)
-    where f' = toFromIntegral2 f
+-- liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect
+-- liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h)
+--     where f' = toFromIntegral f
+liftCvRect :: (CInt -> CInt) -> CvRect -> CvRect
+liftCvRect f (CvRect x y w h) = CvRect (f x) (f y) (f w) (f h)
+
+-- liftCvRect2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvRect -> CvRect -> CvRect
+-- liftCvRect2 f (CvRect x1 y1 w1 h1) (CvRect x2 y2 w2 h2) = CvRect (f' x1 x2) (f' y1 y2) (f' w1 w2) (f' h1 h2)
+--     where f' = toFromIntegral2 f
+liftCvRect2 :: (CInt -> CInt -> CInt) -> CvRect -> CvRect -> CvRect
+liftCvRect2 f (CvRect x1 y1 w1 h1) (CvRect x2 y2 w2 h2) = 
+  CvRect (f x1 x2) (f y1 y2) (f w1 w2) (f h1 h2)
 
 instance AdditiveGroup CvRect where
   zeroV = CvRect 0 0 0 0
   (^+^) = liftCvRect2 (+)
-  negateV = liftCvRect (0-)
+  negateV = liftCvRect (0 -)
 
 instance VectorSpace CvRect where
   type Scalar CvRect = Double -- todo: use CInt instead of Double here?
-  a *^ r = liftCvRect (a*) r
+  a *^ r = liftCvRect (round . (a*) . fromIntegral) r
 
 data CvPoint = CvPoint {-# UNPACK #-} !CInt {-# UNPACK #-} !CInt
 
diff --git a/src/OpenCV/Core/HIplImage.hsc b/src/OpenCV/Core/HIplImage.hsc
deleted file mode 100644
index f4e1037..0000000
--- a/src/OpenCV/Core/HIplImage.hsc
+++ /dev/null
@@ -1,395 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
-             TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
-             BangPatterns, FlexibleContexts, TypeSynonymInstances #-}
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-module OpenCV.Core.HIplImage (
-    -- * Phantom types that statically describe image properties
-    Trichromatic, Monochromatic, HasROI, NoROI,
-
-    -- * Value-level reification of type-level properties
-    HasChannels(..), HasDepth(..), 
-
-    -- * Typed support for image operations that take scalar (color) parameters
-    HasScalar(..), IsCvScalar(..),
-
-    -- * Low-level image data structure
-    HIplImage(..), mkHIplImage, mkBlackImage, withHIplImage, bytesPerPixel, 
-    freeROI, c_cvSetImageROI, 
-    c_cvResetImageROI, origin, width, height, imageSize, roi, imageData, 
-    widthStep, imageDataOrigin, setROI, resetROI, ImgBuilder(..)
-  ) where
-import OpenCV.Core.CxCore (IplImage,Depth(..),iplDepth8u, iplDepth16u, 
-                           iplDepth16s, iplDepth32f, iplDepth64f, cvFree, 
-                           CvRect(..), CvScalar(..))
-import OpenCV.Core.CV (cvCvtColor)
-import OpenCV.Core.ColorConversion (cv_GRAY2BGR, cv_BGR2GRAY)
-import Control.Applicative ((<$>))
-import Control.Monad (when)
-import Data.Bits (complement, (.&.))
-import Data.Int
-import Data.Word (Word8, Word16)
-import Foreign.C.Types
-import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Array (allocaArray, peekArray)
-import Foreign.Ptr
-import Foreign.Storable
-import Unsafe.Coerce
-
-#include <opencv2/core/types_c.h>
-{-
-typedef struct _IplImage
-{
-    int  nSize;
-    int  ID;
-    int  nChannels;
-    int  alphaChannel;
-    int  depth;
-    char colorModel[4];
-    char channelSeq[4];
-    int  dataOrder;
-    int  origin;
-    int  align;
-    int  width;
-    int  height;
-    struct _IplROI *roi;
-    struct _IplImage *maskROI;
-    void  *imageId;
-    struct _IplTileInfo *tileInfo;
-    int  imageSize;
-    char *imageData;
-    int  widthStep;
-    int  BorderMode[4];
-    int  BorderConst[4];
-    char *imageDataOrigin;
-}
-IplImage;
--}
-
--- *Phantom types that statically describe image properties
-data Trichromatic
-data Monochromatic
-data HasROI
-data NoROI
-
--- Rather than the unrelated HasROI and NoROI type tags, we can close
--- the family by using a GADT to define the necessary singleton
--- types. The downside is GHC gives: "Warning: Defined but not used:
--- data constructor `HasROI'". To avoid this warning, I'll stick with
--- the separate type definitions.
-
--- data True
--- data False
-
--- data ROIProp a where
---   HasROI :: ROIProp True
---   NoROI  :: ROIProp False
-
--- type HasROI = ROIProp True
--- type NoROI = ROIProp False
-
--- * Value-level reification of properties encoded in phantom types
-class HasChannels a where
-    numChannels :: a -> CInt
-
-instance HasChannels Trichromatic where numChannels _ = 3
-instance HasChannels Monochromatic where numChannels _ = 1
-
-class (Storable a, Num a) => HasDepth a where
-    depth      :: a -> Depth
-    toDouble   :: a -> Double
-    fromDouble :: Double -> a
-
-instance HasDepth Word8 where 
-    depth _ = iplDepth8u
-    toDouble = fromIntegral
-    fromDouble = round
-instance HasDepth Word16 where 
-    depth _ = iplDepth16u
-    toDouble = fromIntegral
-    fromDouble = round
-instance HasDepth Int16 where 
-    depth _ = iplDepth16s
-    toDouble = fromIntegral
-    fromDouble = round
-instance HasDepth Float where 
-    depth _ = iplDepth32f
-    toDouble = realToFrac
-    fromDouble = realToFrac
-instance HasDepth Double where 
-    depth _ = iplDepth64f
-    toDouble = id
-    fromDouble = id
-
--- |An image with a particular number of channels have an associated
--- scalar type built from the type of its pixels. This class lets us
--- ensure that a scalar value to be used in an operation with an image
--- is compatible with that image.
-class HasDepth d => HasScalar c d where
-    type CvScalarT c d
-
-instance HasDepth d => HasScalar Monochromatic d where
-    type CvScalarT Monochromatic d = d
-
-instance HasDepth d => HasScalar Trichromatic d where
-    type CvScalarT Trichromatic d = (d,d,d)
-
--- |Scalar types are often round-tripped via doubles in OpenCV to
--- allow for non-overloaded interfaces of functions with scalar
--- parameters.
-class IsCvScalar x where
-    toCvScalar :: x -> CvScalar
-    fromCvScalar :: CvScalar -> x
-
-instance IsCvScalar Word8 where
-    toCvScalar = depthToScalar
-    fromCvScalar (CvScalar r _ _ _) = floor r
-
-instance IsCvScalar Word16 where
-    toCvScalar = depthToScalar
-    fromCvScalar (CvScalar r _ _ _) = floor r
-
-instance IsCvScalar Int16 where
-    toCvScalar = depthToScalar
-    fromCvScalar (CvScalar r _ _ _) = floor r
-
-instance IsCvScalar Float where
-    toCvScalar = depthToScalar
-    fromCvScalar (CvScalar r _ _ _) = realToFrac r
-
-instance IsCvScalar Double where
-    toCvScalar = depthToScalar
-    fromCvScalar (CvScalar r _ _ _) = realToFrac r
-
-instance (HasDepth d, IsCvScalar d) => IsCvScalar (d,d,d) where
-    toCvScalar (r,g,b) = let f = realToFrac . toDouble
-                         in CvScalar (f r) (f g) (f b) 0
-    fromCvScalar (CvScalar r g b _) = let f = fromDouble . realToFrac 
-                                      in (f r, f g, f b)
-
-depthToScalar :: HasDepth d => d -> CvScalar
-depthToScalar x = let x' = realToFrac (toDouble x)
-                  in CvScalar x' x' x' x'
-
-bytesPerPixel :: HasDepth d => d -> Int
-bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
-    where unSign = (complement #{const IPL_DEPTH_SIGN} .&.)
-
--- data HIplImage c d = (HasChannels c, HasDepth d) => 
---                      HIplImage { origin          :: {-# UNPACK #-} !CInt
---                                , width           :: {-# UNPACK #-} !CInt
---                                , height          :: {-# UNPACK #-} !CInt
---                                , roi             :: !(Maybe CvRect)
---                                , imageSize       :: {-# UNPACK #-} !CInt
---                                , imageData       :: {-# UNPACK #-} !(ForeignPtr d)
---                                , imageDataOrigin :: {-# UNPACK #-} !(ForeignPtr d)
---                                , widthStep       :: {-# UNPACK #-} !CInt }
-
--- |A data structure representing the information OpenCV uses from an
--- 'IplImage' struct. It includes the pixel origin, image width, image
--- height, image size (number of bytes), a pointer to the pixel data,
--- and the row stride. Its type is parameterized by the number of
--- color channels (i.e. 'Monochromatic' or 'Trichromatic'), the pixel
--- depth (e.g. 'Word8', 'Float'), and whether or not the image has a
--- region-of-interest (ROI) set ('HasROI' or 'NoROI').
-data HIplImage c d r where
-  Img :: (HasChannels c, HasDepth d) => 
-         !CInt -> !CInt -> !CInt -> !CInt -> !(ForeignPtr d) -> !(ForeignPtr d) -> 
-         !CInt -> HIplImage c d NoROI
-  ImgR :: (HasChannels c, HasDepth d) => 
-          !CInt -> !CInt -> !CInt -> !CvRect -> !CInt -> !(ForeignPtr d) -> 
-          !(ForeignPtr d) -> !CInt -> HIplImage c d HasROI
-
-origin :: HIplImage c d r -> CInt
-origin (Img o _ _ _ _ _ _) = o
-origin (ImgR o _ _ _ _ _ _ _) = o
-
-imageSize :: HIplImage c d r -> CInt
-imageSize (Img _ _ _ s _ _ _) = s
-imageSize (ImgR _ _ _ _ s _ _ _) = s
-
-roi :: HIplImage c d r -> Maybe CvRect
-roi (ImgR _ _ _ r _ _ _ _) = Just r
-roi _ = Nothing
-
-imageData :: HIplImage c d r -> ForeignPtr d
-imageData (Img _ _ _ _ p _ _) = p
-imageData (ImgR _ _ _ _ _ p _ _) = p
-
-imageDataOrigin :: HIplImage c d r -> ForeignPtr d
-imageDataOrigin (Img _ _ _ _ _ p _) = p
-imageDataOrigin (ImgR _ _ _ _ _ _ p _) = p
-
-width,height,widthStep :: HIplImage c d r -> CInt
-width (Img _ w _ _ _ _ _) = w
-width (ImgR _ w _ _ _ _ _ _) = w
-height (Img _ _ h _ _ _ _) = h
-height (ImgR _ _ h _ _ _ _ _) = h
-widthStep (Img _ _ _ _ _ _ ws) = ws
-widthStep (ImgR _ _ _ _ _ _ _ ws) = ws
-
--- |Set an image's region-of-interest.
-setROI :: CvRect -> HIplImage c d r -> HIplImage c d HasROI
-setROI r (Img o w h sz d ido ws) = ImgR o w h r sz d ido ws
-setROI r (ImgR o w h _ sz d ido ws) = ImgR o w h r sz d ido ws
-{-# INLINE setROI #-}
-
--- |Clear any region-of-interest set for an image.
-resetROI :: HIplImage c d r -> HIplImage c d NoROI
-resetROI x@(Img _ _ _ _ _ _ _) = x
-resetROI (ImgR o w h _ sz d ido ws) = Img o w h sz d ido ws
-{-# INLINE resetROI #-}
-
--- |Prepare a 'HIplImage' of the given width and height. The pixel and
--- color depths are gleaned from the type, and may often be inferred.
-mkHIplImage :: forall a c d. (HasChannels c, HasDepth d, Integral a) => 
-               a -> a -> IO (HIplImage c d NoROI)
-mkHIplImage w' h' = 
-    do ptr <- mallocForeignPtrArray (fromIntegral numBytes)
-       return $ Img 0 w h numBytes ptr ptr stride
-    where w = fromIntegral w'
-          h = fromIntegral h'
-          numBytes = stride * h
-          bpp = fi $ bytesPerPixel (undefined::d)
-          stride = w * numChannels (undefined::c) * bpp
-          fi = fromIntegral
-
-foreign import ccall "memset"
-  memset :: Ptr Word8 -> Word8 -> CInt -> IO ()
-
--- |Prepare a 'HIplImage' of the given width and height. Set all
--- pixels to zero.
-mkBlackImage :: (HasChannels c, HasDepth d, Integral a) => 
-                a -> a -> IO (HIplImage c d NoROI)
-mkBlackImage w h = do img <- mkHIplImage (fromIntegral w) (fromIntegral h)
-                      let sz = fromIntegral $ imageSize img
-                      withForeignPtr (imageData img) $ \ptr ->
-                          memset (castPtr ptr) 0 sz
-                      return img
-
--- |Provides the supplied function with a 'Ptr' to the 'IplImage'
--- underlying the given 'HIplImage'.
-withHIplImage :: (HasChannels c, HasDepth d) =>
-                 HIplImage c d r -> (Ptr IplImage -> IO b) -> IO b
-withHIplImage img f = alloca $ 
-                      \p -> withForeignPtr (imageData img) 
-                                           (\hp -> pokeIpl img p (castPtr hp) >>
-                                                   withROI img p f)
-
-withROI :: (HasChannels c, HasDepth d) => 
-           HIplImage c d r -> Ptr IplImage -> (Ptr IplImage -> IO a) -> IO a
-withROI img p f = case roi img of
-                    Nothing -> f p
-                    Just (CvRect x y w h) -> do c_cvSetImageROI p x y w h
-                                                r <- f p
-                                                c_cvResetImageROI p
-                                                return r
-
-foreign import ccall "HOpenCV_wrap.h c_cvSetRoi"
-  c_cvSetImageROI :: Ptr IplImage -> CInt -> CInt -> CInt -> CInt -> IO ()
-
-foreign import ccall "opencv2/core/core_c.h cvResetImageROI"
-  c_cvResetImageROI :: Ptr IplImage -> IO ()
-
-foreign import ccall "HOpenCV_wrap.h c_cvGetROI"
-  c_cvGetImageROI :: Ptr IplImage -> Ptr CInt -> IO ()
-
--- Poke a 'Ptr' 'IplImage' with a specific imageData 'Ptr' that is
--- currently valid. This is solely an auxiliary function to
--- 'withHIplImage'.
-pokeIpl :: forall c d r. (HasChannels c, HasDepth d) => 
-           HIplImage c d r -> Ptr IplImage -> Ptr Word8 -> IO ()
-pokeIpl himg ptr hp =
-    do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
-       (#poke IplImage, ID) ptr (0::Int)
-       (#poke IplImage, nChannels) ptr (numChannels (undefined::c))
-       (#poke IplImage, depth) ptr (unDepth (depth (undefined::d)))
-       (#poke IplImage, dataOrder) ptr (0::Int)
-       (#poke IplImage, origin) ptr (origin himg)
-       (#poke IplImage, align) ptr (4::Int)
-       (#poke IplImage, width) ptr (width himg)
-       (#poke IplImage, height) ptr (height himg)
-       (#poke IplImage, roi) ptr nullPtr
-       (#poke IplImage, maskROI) ptr nullPtr
-       (#poke IplImage, imageId) ptr nullPtr
-       (#poke IplImage, tileInfo) ptr nullPtr
-       (#poke IplImage, imageSize) ptr (imageSize himg)
-       (#poke IplImage, imageData) ptr hp
-       (#poke IplImage, widthStep) ptr (widthStep himg)
-       (#poke IplImage, imageDataOrigin) ptr hp
-
-freeROI :: Ptr IplImage -> IO ()
-freeROI ptr = do p <- (#peek IplImage, roi) ptr
-                 if (ptrToIntPtr p == 0) then return () else cvFree p
-
-maybePeek :: Ptr IplImage -> Ptr () -> IO (Maybe CvRect)
-maybePeek img p | p == nullPtr = return Nothing
-                | otherwise = allocaArray 4 $ 
-                              \r -> do c_cvGetImageROI img r
-                                       [x,y,w,h] <- peekArray 4 r
-                                       return . Just $ CvRect x y w h
-
-class ImgBuilder a where
-  buildImg :: (HasChannels c, HasDepth d) =>
-              CInt -> CInt -> CInt -> Maybe CvRect -> CInt ->
-              ForeignPtr d -> ForeignPtr d -> CInt -> HIplImage c d a
-  addMaybeROI :: Maybe CvRect -> (HIplImage c d r) -> HIplImage c d a
-
-instance ImgBuilder NoROI where
-  buildImg o w h Nothing sz d ido ws = Img o w h sz d ido ws
-  buildImg _ _ _ _ _ _ _ _ = error "Building a NoROI image, but was given a ROI!"
-  addMaybeROI Nothing x = resetROI x
-  addMaybeROI _ _ = error "addMaybeROI tried to add a ROI to a NoROI Image!"
-
-instance ImgBuilder HasROI where
-  buildImg o w h (Just r) sz d ido ws = ImgR o w h r sz d ido ws
-  buildImg _ _ _ _ _ _ _ _ = error "Building a ROI image, but wasn't given a ROI!"
-  addMaybeROI (Just r) x = setROI r x
-  addMaybeROI _ _ = error "addMaybeROI tried to add a null ROI to a HasROI Image!"
-
--- |An 'HIplImage' in Haskell conforms closely to OpenCV's 'IplImage'
--- structure type. Note that obtaining an 'HIplImage' from an
--- 'IplImage' via 'peek' will not install a Haskell finalizer on the
--- underlying pixel data. That data is the responsibility of the
--- provider of the 'IplImage'. 'HIplImage' values constructed within
--- the Haskell runtime, on the other hand, will have their underlying
--- pixel data buffers managedy by the garbage collector.
-instance forall c d r. (HasChannels c, HasDepth d, ImgBuilder r) => 
-    Storable (HIplImage c d r) where
-    sizeOf _ = (#size IplImage)
-    alignment _ = alignment (undefined :: CDouble)
-    poke = error "Poking a Ptr HIplImage is unsafe."
-    peek ptr = do
-      numChannels' <- (#peek IplImage, nChannels) ptr :: IO CInt
-      depth' <- Depth <$> (#peek IplImage, depth) ptr
-      width' <- (#peek IplImage, width) ptr
-      height' <- (#peek IplImage, height) ptr
-      roir <- (#peek IplImage, roi) ptr >>= maybePeek (castPtr ptr)
-      when (depth' /= (depth (undefined::d)))
-           (error $ "IplImage has depth "++show depth'++
-                    " but desired HIplImage has depth "++
-                    show (depth (undefined::d)))
-      if numChannels (undefined::c) /= numChannels'
-        then do img2' <- mkHIplImage width' height' :: IO (HIplImage c d NoROI)
-                let img2 = addMaybeROI roir img2' :: HIplImage c d r
-                let conv = if numChannels' == 1 
-                           then cv_GRAY2BGR
-                           else cv_BGR2GRAY
-                    ptr' = castPtr ptr :: Ptr IplImage
-                withHIplImage img2 $ \dst -> cvCvtColor (castPtr ptr') 
-                                                        (castPtr dst) 
-                                                        conv
-                (#peek IplImage, imageDataOrigin) ptr >>= cvFree
-                return $ unsafeCoerce img2
-        else do origin' <- (#peek IplImage, origin) ptr
-                imageSize' <- (#peek IplImage, imageSize) ptr
-                imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
-                imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
-                widthStep' <- (#peek IplImage, widthStep) ptr
-                return $ buildImg origin' width' height' roir imageSize'
-                                  imageData' imageDataOrigin' widthStep'
-                -- return $ case roir of
-                --            Nothing -> Img origin' width' height' imageSize' 
-                --                           imageData' imageDataOrigin' widthStep'
-                --            Just r -> ImgR origin' width' height' r imageSize' 
-                --                           imageData' imageDataOrigin' widthStep'
diff --git a/src/OpenCV/Core/HIplUtil.hs b/src/OpenCV/Core/HIplUtil.hs
deleted file mode 100644
index b9678f2..0000000
--- a/src/OpenCV/Core/HIplUtil.hs
+++ /dev/null
@@ -1,335 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, BangPatterns, MultiParamTypeClasses, 
-             FlexibleInstances #-}
--- |Functions for working with 'HIplImage's.
-module OpenCV.Core.HIplUtil
-    (isColor, isMono, imgChannels, withPixelVector, pixels,
-     fromPtr, fromFileColor, fromFileGray, fromPGM16, toFile, 
-     compatibleImage, duplicateImage, fromPixels,
-     withImagePixels, fromGrayPixels, fromColorPixels,
-     withDuplicateImage, withCompatibleImage, setROI, resetROI,
-     mkHIplImage, width, height, numPixels, mkBlackImage, HIplImage, 
-     NoROI, HasROI, withHIplImage, Monochromatic, Trichromatic, HasChannels, 
-     ImgBuilder(..), GrayImage, GrayImage16, GrayImage16S, ColorImage, 
-     c_cvSetImageROI, c_cvResetImageROI,
-     HasDepth(..), HasScalar(..), IsCvScalar(..), colorDepth,
-     ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
-     duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
-import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF, 
-                           CvSize(..), cloneImageF, cvCreateImage, 
-                           getNumChannels, getDepth, cvGetSize)
-import OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
-import OpenCV.Core.HIplImage
-import Control.Applicative
-import Control.Arrow (second, (***))
-import Control.Monad (when, unless, join)
-import Data.Int (Int16)
-import qualified Data.Vector.Storable as V
-import Data.Word (Word8, Word16)
-import Foreign.ForeignPtr
-import Foreign.Marshal.Utils (copyBytes)
-import Foreign.Ptr
-import Foreign.Storable
-import System.Directory (doesFileExist)
-import System.IO (openFile, hGetLine, hGetBuf, hClose, hSetBinaryMode, 
-                  IOMode(..))
-import System.IO.Unsafe
-
--- |Some operations are restricted to bytes or floats.
-class (HasDepth a, Num a) => ByteOrFloat a where
-instance ByteOrFloat Word8 where
-instance ByteOrFloat Float where
-
--- |Grayscale 8-bit (per-pixel) image type.
-type GrayImage = HIplImage Monochromatic Word8 NoROI
-
--- |Grayscale unsigned 16-bit (per-pixel) image type.
-type GrayImage16 = HIplImage Monochromatic Word16 NoROI
-
--- |Grayscale signed 16-bit (per-pixel) image type.
-type GrayImage16S = HIplImage Monochromatic Int16 NoROI
-
--- |Color 8-bit (per-color) image type.
-type ColorImage = HIplImage Trichromatic Word8 NoROI
-
--- |This is a way to let the type checker know that you belieave an
--- image to be tri-chromatic. If your image type can't be inferred any
--- other way, this is an alternative to adding a type annotation.
-isColor :: HIplImage Trichromatic d r -> HIplImage Trichromatic d r
-isColor = id
-
--- |This is a way to let the type checker know that you believe an
--- image to be monochromatic. If your image type can't be inferred any
--- other way, this is an alternative to adding a type annotation.
-isMono :: HIplImage Monochromatic d r -> HIplImage Monochromatic d r
-isMono = id
-
-{-# INLINE isMono #-}
-{-# INLINE isColor #-}
-
--- |Return the number of color channels a 'HIplImage' has as a runtime
--- value.
-imgChannels :: forall c d r. HasChannels c => HIplImage c d r -> Int
-imgChannels _ = fromIntegral $ numChannels (undefined::c)
-
--- |Return the number of bytes per pixel color component of an
--- 'HIplImage'.
-colorDepth :: forall c d r. HasDepth d => HIplImage c d r -> Int
-colorDepth _ = bytesPerPixel (undefined::d)
-
--- |The number of pixels in the image: @width img * height img@.
-numPixels :: HIplImage c d r -> Int
-numPixels = fromIntegral . ((*) <$> width <*> height)
-
--- |Apply the supplied function to a 'V.Vector' containing the pixels
--- that make up an 'HIplImage'. This does not copy the underlying
--- data.
-withImagePixels :: HasDepth d => HIplImage c d NoROI -> (V.Vector d -> r) -> r
-withImagePixels img f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
-    where n = fromIntegral (imageSize img) `div` colorDepth img
-
--- |Return a 'V.Vector' containing a copy of the pixels that make up a
--- 'HIplImage'.
-pixels :: Storable d => HIplImage c d NoROI -> V.Vector d
-pixels img = unsafePerformIO $ 
-             do ptr <- mallocForeignPtrBytes len
-                withForeignPtr ptr $ \dst -> 
-                    withForeignPtr (imageData img) $ \src -> 
-                        copyBytes dst src len
-                return $ V.unsafeFromForeignPtr ptr 0 len
-    where len = fromIntegral $ imageSize img
-{-# NOINLINE pixels #-}
-
--- |Read a 'HIplImage' from a 'Ptr' 'IplImage'
-fromPtr :: (HasChannels c, HasDepth d, ImgBuilder r) => 
-           Ptr IplImage -> IO (HIplImage c d r)
-fromPtr = peek . castPtr
-
--- Ensure that a file exists.
-checkFile :: FilePath -> IO ()
-checkFile f = do e <- doesFileExist f
-                 unless e (error $ "Can't find "++f)
-
--- |Load a color 'HIplImage' from an 8-bit image file. If the image
--- file is grayscale, it will be converted to color.
-fromFileColor :: FilePath -> IO (HIplImage Trichromatic Word8 NoROI)
-fromFileColor fileName = 
-  do checkFile fileName
-     ptr <- cvLoadImage fileName LoadColor
-     img <- fromPtr ptr :: IO (HIplImage Trichromatic Word8 NoROI)
-     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
-     freeROI ptr
-     cvFree ptr
-     return img
-
--- |Load a grayscale 'HIplImage' from an 8-bit image file. If the
--- image file is color, it will be converted to grayscale.
-fromFileGray :: FilePath -> IO (HIplImage Monochromatic Word8 NoROI)
-fromFileGray fileName = 
-  do checkFile fileName
-     ptr <- cvLoadImage fileName LoadGray
-     img <- fromPtr ptr :: IO (HIplImage Monochromatic Word8 NoROI)
-     addForeignPtrFinalizer cvFreePtr (imageDataOrigin img)
-     return img
-
--- |If the type of a loaded image is known (e.g. by a type annotation,
--- or usage of a narrowly typed functions), then we can automatically
--- dispatch to the proper image loading routine.
-class LoadableFormat c d where
-  loadFormat :: (c,d) -> FilePath -> IO (HIplImage c d NoROI)
-
-instance LoadableFormat Monochromatic Word8 where
-  loadFormat _ = fromFileGray
-
-instance LoadableFormat Trichromatic Word8 where
-  loadFormat _ = fromFileColor
-
-instance LoadableFormat Monochromatic Word16 where
-  loadFormat _ = fromPGM16
-
--- |An overloaded image file loader. The number of color channels and
--- color depth parts of the returned image's type must be inferrable
--- as they control how the image file is loaded.
-fromFile :: forall c d. LoadableFormat c d => FilePath -> IO (HIplImage c d NoROI)
-fromFile = loadFormat (undefined :: (c,d))
-
--- |Load a grayscale 'HIplImage' from a 16-bit image file. NOTE:
--- OpenCV (as of v2.2) does not correctly handle 16-bit PGM loading,
--- so this 16bpp loader is restricted to PGM. This loading routine
--- converts from Most Significant Byte first (MSB) byte ordering (as
--- per the PGM spec) to LSB byte ordering for x86 compatibility.
-fromPGM16 :: FilePath -> IO (HIplImage Monochromatic Word16 NoROI)
-fromPGM16 fileName = 
-  do checkFile fileName
-     h <- openFile fileName ReadMode
-     magic <- hGetLine h
-     when (magic /= "P5") (hClose h >> 
-                           error (fileName ++" is not a PGM"))
-     (width, height) <- fmap ((read***read). second tail . break (==' '))
-                             (hGetLine h)
-     maxCol <- hGetLine h
-     when (maxCol /= "65535") (hClose h >>
-                               error (fileName ++" is not 16-bit"))
-     let numBytes = fromIntegral $ width*height*2
-     fp <- mallocForeignPtrArray numBytes
-     hSetBinaryMode h True
-     withForeignPtr fp $ \ptr' ->
-       do let ptr = castPtr ptr' :: Ptr Word8
-          n <- hGetBuf h ptr numBytes
-          when (n /= numBytes) (hClose h >> 
-                                error (fileName ++" unexpected EOF"))
-          let swapBytes !offset
-                | offset == numBytes = return ()
-                | otherwise = do temp1 <- peekByteOff ptr offset :: IO Word8
-                                 temp2 <- peekByteOff ptr (offset+1) :: IO Word8
-                                 pokeByteOff ptr offset temp2
-                                 pokeByteOff ptr (offset+1) temp1
-                                 swapBytes (offset+2)
-          swapBytes 0
-     hClose h
-     return $ Img 0 width height (fromIntegral numBytes) fp fp (2*width)
-
--- |Save an image to the specified file.
-toFile :: (HasChannels c, HasDepth d) => FilePath -> HIplImage c d r -> IO ()
-toFile fileName img = withHIplImage img $ \ptr -> cvSaveImage fileName ptr
-
--- |Allocate a new 'HIplImage' with the same dimensions, number of
--- color channels, and color depth as an existing HIplImage. The pixel
--- data of the original 'HIplImage' is not copied.
-compatibleImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
-                   HIplImage c d r -> IO (HIplImage c d r)
-compatibleImage img = 
-    do ptr <- mallocForeignPtrArray (fromIntegral (imageSize img))
-       return $ buildImg 0 (width img) (height img) (roi img) 
-                         (imageSize img) ptr ptr (widthStep img)
-
--- |Allocate a new 'IplImage' with the same dimensions, number of
--- color channels, and color depth as an existing 'HIplImage'. The
--- pixel data of the original 'HIplImage' is not copied.
-compatibleImagePtr :: forall c d r. (HasChannels c, HasDepth d) =>
-                      HIplImage c d r -> IO (ForeignPtr IplImage)
-compatibleImagePtr img = createImageF (CvSize w' h') nc d
-    where w' = fromIntegral . width $ img
-          h' = fromIntegral . height $ img
-          nc = fromIntegral . numChannels $ (undefined::c)
-          d = depth (undefined::d)
-
-compatibleImagePtrPtr :: Ptr IplImage -> IO (Ptr IplImage)
-compatibleImagePtrPtr = 
-    join . (liftA3 cvCreateImage <$> cvGetSize <*> getNumChannels <*> getDepth)
-
--- |Create an exact duplicate of the given HIplImage. This allocates a
--- fresh array to store the copied pixels.
-duplicateImage :: (HasChannels c, HasDepth d, ImgBuilder r) =>
-                  HIplImage c d r -> IO (HIplImage c d r)
---duplicateImage (HIplImage _ w h r sz pixels _ stride) =
-duplicateImage img =
-    do fptr <- mallocForeignPtrArray sz'
-       withForeignPtr (imageData img) $ 
-           \src -> withForeignPtr fptr $ \dst -> copyBytes dst src sz'
-       return $ buildImg 0 (width img) (height img) (roi img) 
-                         (imageSize img) fptr fptr (widthStep img)
-  where sz' = fromIntegral (imageSize img)
-
--- |Clone an 'HIplImage', returning the 'Ptr' 'IplImage' underlying
--- the clone.
-duplicateImagePtr :: (HasChannels c, HasDepth d) =>
-                     HIplImage c d r -> IO (ForeignPtr IplImage)
-duplicateImagePtr = flip withHIplImage cloneImageF
-
--- |Pass the given function a 'HIplImage' constructed from a width, a
--- height, and a 'V.Vector' of pixel values. The new 'HIplImage' \'s
--- pixel data is shared with the supplied 'V.Vector'.
-withPixelVector :: forall a c d r. 
-                   (HasChannels c, Integral a, HasDepth d) =>
-                   a -> a -> V.Vector d -> (HIplImage c d NoROI -> r) -> r
-withPixelVector w h pix f = if fromIntegral len == sz
-                            then f $ Img 0 w' h' sz fp fp (w'*nc)
-                            else error "Length disagreement"
-    where w' = fromIntegral w
-          h' = fromIntegral h
-          nc = numChannels (undefined::c)
-          sz = w' * h' * nc
-          (fp,len) = case V.unsafeToForeignPtr (V.force pix) of
-                         (fp,0,len) -> (fp,len)
-                         _ -> error "fromPixels non-zero offset"
-
--- |Construct a fresh 'HIplImage' from a width, a height, and a
--- 'V.Vector' of pixel values.
-fromPixels :: forall a c d. 
-              (Integral a, HasChannels c, HasDepth d) =>
-              a -> a -> V.Vector d -> HIplImage c d NoROI
-fromPixels w h pix = unsafePerformIO $ 
-                     do fp <- copyData
-                        return $ Img 0 w' h' sz fp fp (w'*nc)
-    where w' = fromIntegral w
-          h' = fromIntegral h
-          nc = numChannels (undefined::c)
-          sz = w' * h' * nc
-          copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
-                     in do fp <- mallocForeignPtrBytes len
-                           withForeignPtr vfp $
-                             \src -> withForeignPtr fp $
-                                       \dst -> let src' = plusPtr src offset
-                                               in copyBytes dst src' len
-                           return fp
-{-# INLINE [0] fromPixels #-}
-
--- |Helper function to explicitly type a vector of monochromatic pixel
--- data. Parameters are the output image's width, height, and pixel
--- content.
-fromGrayPixels :: (HasDepth d, Integral a) => 
-                  a -> a -> V.Vector d -> HIplImage Monochromatic d NoROI
-fromGrayPixels w h = isMono . fromPixels w h
-
--- |Helper function to explicitly type a vector of interleaved
--- trichromatic pixel data. Parameters are the output image's width,
--- height, and pixel content.
-fromColorPixels :: (HasDepth d, Integral a) =>
-                   a -> a -> V.Vector d -> HIplImage Trichromatic d NoROI
-fromColorPixels w h = isColor . fromPixels w h
-
--- |Provides the supplied function with a 'Ptr' to the 'IplImage'
--- underlying a new 'HIplImage' that is an exact duplicate of the
--- given 'HIplImage'. Returns the duplicate 'HIplImage' after
--- performing the given action along with the result of that action.
-withDuplicateImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
-                      HIplImage c d r -> (Ptr IplImage -> IO b) -> 
-                      IO (HIplImage c d r, b)
-withDuplicateImage img1 f = do img2 <- duplicateImage img1
-                               r <- withHIplImage img2 f
-                               return (img2, r)
-
--- |Provides the supplied function with a 'Ptr' to the 'IplImage'
--- underlying a new 'HIplImage' of the same dimensions as the given
--- 'HIplImage'.
-withCompatibleImage :: (HasChannels c, HasDepth d, ImgBuilder r) => 
-                       HIplImage c d r -> (Ptr IplImage -> IO b) -> 
-                       IO (HIplImage c d r, b)
-withCompatibleImage img1 f = do img2 <- compatibleImage img1
-                                r <- withHIplImage img2 f
-                                return (img2, r)
-
-unsafeWithHIplImage :: (HasChannels c, HasDepth d) =>
-                       HIplImage c d r -> (Ptr IplImage -> a) -> a
-unsafeWithHIplImage img f = unsafePerformIO $ withHIplImage img (return . f)
-
--- |Extract a rectangular region of interest from an image. Returns a
--- new image whose pixel data is copied from the given rectangle of
--- the source image. Parameters are the upper-left corner of the
--- rectangle in image coordinates, the (width,height) of the rectangle
--- in pixels, and the source 'HIplImage'.
-getRect :: (HasChannels c, HasDepth d) =>
-           (Int,Int) -> (Int,Int) -> HIplImage c d r -> IO (HIplImage c d NoROI)
-getRect (rx,ry) (rw,rh) src = 
-    do img <- mkHIplImage (fromIntegral rw) (fromIntegral rh)
-       withForeignPtr (imageData img) $ \dst ->
-         withForeignPtr (imageData src) $ \src ->
-           mapM_ (\(dOff, sOff) -> copyBytes (plusPtr dst dOff) 
-                                             (plusPtr src sOff)
-                                             rowLen)
-                 (zip [0,rowLen..rw*rh*bpp-1] [start,start+stride..])
-       return img
-    where stride = fromIntegral $ widthStep src
-          start = stride*ry + rx*bpp
-          bpp = imgChannels src * colorDepth src
-          rowLen = rw*bpp
diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc
index 6baeace..63d1345 100644
--- a/src/OpenCV/Core/Image.hsc
+++ b/src/OpenCV/Core/Image.hsc
@@ -1,7 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables, 
              TypeFamilies, MultiParamTypeClasses, FlexibleInstances, GADTs, 
              BangPatterns, FlexibleContexts, TypeSynonymInstances,
-             DataKinds, TemplateHaskell #-}
+             DataKinds, TemplateHaskell, ConstraintKinds #-}
 {-# OPTIONS_GHC -funbox-strict-fields -fno-warn-unused-binds #-}
 module OpenCV.Core.Image (
     -- * Phantom types that statically describe image properties
@@ -11,7 +11,7 @@ module OpenCV.Core.Image (
     HasDepth(..), 
 
     -- * Typed support for image operations that take scalar (color) parameters
-    CvScalarT, AsCvScalar(..),
+    CvScalarT, AsCvScalar(..), ScalarOK,
 
     -- * Low-level image data structure
     Image(..), mkImage, mallocImage, blackImage, blackoutPixels, 
@@ -132,6 +132,8 @@ type family CvScalarT (c::Channels) d :: *
 type instance CvScalarT Monochromatic d = d
 type instance CvScalarT Trichromatic d = (d,d,d)
 
+type ScalarOK s c d = (AsCvScalar s, s ~ CvScalarT c d)
+
 -- |Scalar types are often round-tripped via doubles in OpenCV to
 -- allow for non-overloaded interfaces of functions with scalar
 -- parameters.
@@ -181,7 +183,7 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- depth (e.g. 'Word8', 'Float'), and whether or not the image has a
 -- region-of-interest (ROI) set ('HasROI' or 'NoROI').
 data Image (c::Channels) d (r::ROIEnabled) where
-  Image :: (SingI c, HasDepth d, SingI r) => 
+  Image :: (SingI c, HasDepth d, SingI r, UpdateROI r) => 
            { origin :: !CInt
            , width :: !CInt
            , height :: !CInt
@@ -306,7 +308,7 @@ maybePeekROI img p | p == nullPtr = return Nothing
 
 -- |An internal class that makes runtime guarantees about type level
 -- ROI assertions.
-class UpdateROI (a::ROIEnabled) where
+class SingI a => UpdateROI (a::ROIEnabled) where
   updateROI :: Maybe CvRect -> Image c d a -> Image c d b
 
 -- These functions are runtime checks that type-level guarantees are
diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index 82b5162..8e679f0 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -7,12 +7,13 @@ module OpenCV.Core.ImageUtil
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, setROI, resetROI,
-     mkImage, width, height, numPixels, blackImage, Image, 
+     mkImage, mallocImage, numPixels, blackImage, Image(..), 
      ROIEnabled(..), withIplImage, Channels(..), 
      GrayImage, GrayImage16, GrayImage16S, ColorImage, 
      c_cvSetImageROI, c_cvResetImageROI,
-     HasDepth(..), CvScalarT, AsCvScalar(..), colorDepth,
-     ByteOrFloat, getRect, imageData, fromFile, unsafeWithHIplImage,
+     HasDepth(..), CvScalarT, AsCvScalar(..), ScalarOK,
+     colorDepth, UpdateROI, SingI,
+     ByteOrFloat, getRect, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
 import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF,
                            cloneImageF, cvCreateImage, CvSize(..),
diff --git a/src/OpenCV/Drawing.hsc b/src/OpenCV/Drawing.hsc
index afeb147..91064a6 100644
--- a/src/OpenCV/Drawing.hsc
+++ b/src/OpenCV/Drawing.hsc
@@ -2,7 +2,7 @@
 module OpenCV.Drawing (prepFont, prepFontAlt, putText, FontFace(..), 
                        LineType(..), RGB, drawLines, fillConvexPoly) where
 import OpenCV.Core.CxCore
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 import OpenCV.Core.StorableUtil
 import Data.Bits ((.|.))
@@ -45,10 +45,10 @@ defaultFont = unsafePerformIO $ initFont NormalSans False 1 1 0 1 EightConn
 -- a text-drawing function using a font with the given @face@ (which
 -- may be @italic@), horizontal and verticale scale, and line
 -- @thickness@.
-prepFont :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+prepFont :: (HasDepth d, UpdateROI r) =>
             FontFace -> Bool -> CDouble -> CDouble -> CInt -> 
             IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-                HIplImage c d r -> HIplImage c d r)
+                Image c d r -> Image c d r)
 prepFont face italic hscale vscale thickness = 
     prepFontAlt face italic hscale vscale 0 thickness EightConn
 {-# INLINE prepFont #-}
@@ -69,11 +69,11 @@ foreign import ccall "cvPutText_wrap"
 -- ltype@ produces a text-drawing function using a font with the given
 -- @face@ (which may be @italic@), horizontal and vertical scale,
 -- @shear@, line @thickness@, and line type.
-prepFontAlt :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+prepFontAlt :: (HasDepth d, UpdateROI r) =>
                FontFace -> Bool -> CDouble -> CDouble -> CDouble -> 
                CInt -> LineType ->
                IO ((CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-                   HIplImage c d r -> HIplImage c d r)
+                   Image c d r -> Image c d r)
 prepFontAlt face italic hscale vscale shear thickness ltype =     
     do f <- initFont face italic hscale vscale shear thickness ltype
        let go (x,y) (r,g,b) msg = cv $ \dst -> 
@@ -86,9 +86,9 @@ prepFontAlt face italic hscale vscale shear thickness ltype =
        return go
 {-# INLINE prepFontAlt #-}
 
-putText :: (HasChannels c, HasDepth d, ImgBuilder r) => 
+putText :: (HasDepth d, UpdateROI r) => 
            (CInt, CInt) -> (CDouble, CDouble, CDouble) -> String -> 
-           HIplImage c d r -> HIplImage c d r
+           Image c d r -> Image c d r
 putText (x,y) (r,g,b) msg = cv $ \dst ->
                             withCString msg $ \msg' ->
                             withS (CvPoint x y) $ \ptPtr ->
@@ -115,11 +115,11 @@ lineTypeEnum FourConn  = 4
 lineTypeEnum AALine    = 16
 
 -- |Draw each line, defined by its endpoints, on a duplicate of the
--- given 'HIplImage' using the specified RGB color, line thickness,
+-- given 'Image' using the specified RGB color, line thickness,
 -- and aliasing style.
-drawLines :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+drawLines :: (HasDepth d, UpdateROI r) =>
              RGB -> Int -> LineType -> [((Int,Int),(Int,Int))] -> 
-             HIplImage c d r -> HIplImage c d r
+             Image c d r -> Image c d r
 drawLines col thick lineType lines = 
     cv $ \img -> mapM_ (draw img) lines
     where draw ptr (pt1, pt2) = cvLine ptr pt1 pt2 col thick lineType'
@@ -129,9 +129,8 @@ drawLines col thick lineType lines =
 -- |Draw a filled, convex polygon. Can draw all monotonic polygons
 -- without self-intersections including those with horizontal top or
 -- bottom edges.
-fillConvexPoly :: (HasChannels c, HasDepth d, ImgBuilder r) =>
-                  RGB -> LineType -> [(Int,Int)] -> 
-                  HIplImage c d r -> HIplImage c d r
+fillConvexPoly :: (HasDepth d, UpdateROI r) =>
+                  RGB -> LineType -> [(Int,Int)] -> Image c d r -> Image c d r
 fillConvexPoly (r,g,b) lineType pts = 
   cv $ \img -> withArray (concatMap flatten pts) $ \pts' ->
                c_cvFillConvexPoly img pts' (fi $ length pts) 
diff --git a/src/OpenCV/FeatureDetection.hs b/src/OpenCV/FeatureDetection.hs
index e16d736..102812b 100644
--- a/src/OpenCV/FeatureDetection.hs
+++ b/src/OpenCV/FeatureDetection.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE ForeignFunctionInterface, FlexibleContexts #-}
+{-# LANGUAGE ForeignFunctionInterface, FlexibleContexts, DataKinds #-}
 -- |Feature Detection.
 module OpenCV.FeatureDetection (cornerHarris, cornerHarris', canny) where
 import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
 import OpenCV.Core.CxCore
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvCornerHarris"
@@ -21,8 +21,8 @@ type M = Monochromatic
 -- |Equivalent to 'cornerHarris'' with an @aperture@ of @3@ and a @k@
 -- of @0.04@.
 cornerHarris :: (ByteOrFloat d, Inplace r M d M Float) => 
-                Int -> HIplImage Monochromatic d r -> 
-                HIplImage Monochromatic Float r
+                Int -> Image Monochromatic d r -> 
+                Image Monochromatic Float r
 cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 {-# INLINE cornerHarris #-}
 
@@ -33,10 +33,10 @@ cornerHarris blockSize = cornerHarris' blockSize 3 0.04
 -- destination image. The parameters are the @blockSize@, the
 -- @aperture@ size to be used by the Sobel operator that is run during
 -- corner evaluation, the value of @k@, and the source
--- 'HIplImage'.
+-- 'Image'.
 cornerHarris' :: (ByteOrFloat d, Inplace r M d M Float) => 
-                 Int -> Int -> Double -> HIplImage Monochromatic d r -> 
-                 HIplImage Monochromatic Float r
+                 Int -> Int -> Double -> Image Monochromatic d r -> 
+                 Image Monochromatic Float r
 cornerHarris' blockSize aperture k = 
     cv2 $ \src dst -> harris src dst blockSize aperture k
 {-# INLINE cornerHarris' #-}
@@ -50,8 +50,8 @@ foreign import ccall "opencv2/imgprog/imgproc_c.h cvCanny"
 -- smaller threshold is used for edge linking. The third parameter is
 -- the aperture size used for initial Sobel operator edge detection.
 canny :: (HasDepth d, Inplace r M d M d) =>
-         Double -> Double -> Int -> HIplImage Monochromatic d r -> 
-         HIplImage Monochromatic d r
+         Double -> Double -> Int -> Image Monochromatic d r -> 
+         Image Monochromatic d r
 canny t1 t2 aperture = 
     cv2 $ \src dst -> c_cvCanny src dst (rf t1) (rf t2) (fi aperture)
     --cv $ \src -> c_cvCanny src src (rf t1) (rf t2) (fi aperture)
diff --git a/src/OpenCV/Filtering.hsc b/src/OpenCV/Filtering.hsc
index 882486d..188b2d7 100644
--- a/src/OpenCV/Filtering.hsc
+++ b/src/OpenCV/Filtering.hsc
@@ -8,7 +8,7 @@ import Data.Int (Int16)
 import Foreign.C.Types (CInt(..), CDouble(..))
 import Foreign.Ptr (Ptr, castPtr)
 import OpenCV.Core.CxCore
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 
 #include <opencv2/imgproc/types_c.h>
@@ -30,25 +30,25 @@ cvGaussian = #{const CV_GAUSSIAN}
 
 -- |Smooth a source image using a linear convolution with a Gaussian
 -- kernel. Parameters are the kernel width and the source
--- 'HIplImage'. The kernel height will be set to the same value as the
+-- 'Image'. The kernel height will be set to the same value as the
 -- width, and the Gaussian standard deviation will be calculated from
 -- the kernel size. This function is the same as calling
 -- @smoothGaussian' width Nothing Nothing@. May be performed in-place
 -- under composition.
-smoothGaussian :: (ByteOrFloat d, HasChannels c, Inplace r c d c d) => 
-                  Int -> HIplImage c d r -> HIplImage c d r
+smoothGaussian :: (ByteOrFloat d, Inplace r c d c d) => 
+                  Int -> Image c d r -> Image c d r
 smoothGaussian w = smoothGaussian' w Nothing Nothing
 {-# INLINE smoothGaussian #-}
 
--- |Smooth a source 'HIplImage' using a linear convolution with a
+-- |Smooth a source 'Image' using a linear convolution with a
 -- Gaussian kernel. Parameters are the kernel width, the kernel height
 -- (if 'Nothing', the height will be set to the same value as the
 -- width), the Gaussian standard deviation (if 'Nothing', it will be
 -- calculated from the kernel size), and the source image. May be
 -- performed in-place under composition.
-smoothGaussian' :: (ByteOrFloat d, HasChannels c, Inplace r c d c d) => 
-                   Int -> Maybe Int -> Maybe Double -> HIplImage c d r -> 
-                   HIplImage c d r
+smoothGaussian' :: (ByteOrFloat d, Inplace r c d c d) => 
+                   Int -> Maybe Int -> Maybe Double -> Image c d r -> 
+                   Image c d r
 smoothGaussian' w h sigma = 
     cv2 $ \src dst -> smooth src dst cvGaussian w h' sigma' 0
     where sigma' = case sigma of { Nothing -> 0; Just s -> s }
@@ -85,10 +85,9 @@ type instance SobelDest Float = Float
 
 -- |Calculates the first, second, third or mixed image derivatives
 -- using an extended Sobel operators. @sobel xOrder yOrder apertureSize img@
-sobel :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, 
-          HasChannels c, Inplace r c d1 c d2) =>
+sobel :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, Inplace r c d1 c d2) =>
          DerivativeOrder -> DerivativeOrder -> ApertureSize -> 
-         HIplImage c d1 r -> HIplImage c d2 r
+         Image c d1 r -> Image c d2 r
 sobel xOrder yOrder apertureSize = cv2 $ \src dst -> cvSobel src dst x y ap
   where ap = apertureToInt apertureSize
         x = orderToInt xOrder
@@ -96,15 +95,13 @@ sobel xOrder yOrder apertureSize = cv2 $ \src dst -> cvSobel src dst x y ap
 {-# INLINE sobel #-}
 
 -- |Compute the first X derivative of an image using a Sobel operator.
-sobelDX :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, 
-            HasChannels c, Inplace r c d1 c d2) =>
-           ApertureSize -> HIplImage c d1 r -> HIplImage c d2 r
+sobelDX :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, Inplace r c d1 c d2) =>
+           ApertureSize -> Image c d1 r -> Image c d2 r
 sobelDX = sobel OrderOne OrderZero
 {-# INLINE sobelDX #-}
 
 -- |Compute the first Y derivative of an image using a Sobel operator.
-sobelDY :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1,
-            HasChannels c, Inplace r c d1 c d2) =>
-            ApertureSize -> HIplImage c d1 r -> HIplImage c d2 r
+sobelDY :: (HasDepth d1, HasDepth d2, d2 ~ SobelDest d1, Inplace r c d1 c d2) =>
+            ApertureSize -> Image c d1 r -> Image c d2 r
 sobelDY = sobel OrderZero OrderOne
 {-# INLINE sobelDY #-}
\ No newline at end of file
diff --git a/src/OpenCV/FloodFill.hsc b/src/OpenCV/FloodFill.hsc
index d0ba9a4..5c43000 100644
--- a/src/OpenCV/FloodFill.hsc
+++ b/src/OpenCV/FloodFill.hsc
@@ -5,7 +5,7 @@ import Data.Bits ((.|.))
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr, castPtr)
 import OpenCV.Core.CxCore 
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 import OpenCV.Core.StorableUtil
 
@@ -62,12 +62,11 @@ floodHelper (x,y) newVal loDiff upDiff range src =
 -- pixel; a flag indicating whether pixels under consideration for
 -- painting should be compared to the seed pixel ('FloodFixed') or to
 -- their neighbors ('FloodFloating'); the source image.
-floodFill :: (ByteOrFloat d, HasChannels c, HasScalar c d, 
-              IsCvScalar s, s ~ CvScalarT c d, ImgBuilder r) => 
-             (Int, Int) -> s -> s -> s -> FloodRange -> HIplImage c d r -> 
-             HIplImage c d r
-floodFill seed newVal loDiff upDiff range = 
-    cv $ floodHelper seed (toCvScalar newVal) (toCvScalar loDiff)
-                     (toCvScalar upDiff) range
+floodFill :: (ByteOrFloat d, AsCvScalar s, s ~ CvScalarT c d) => 
+             (Int, Int) -> s -> s -> s -> FloodRange -> 
+             Image c d r -> Image c d r
+floodFill seed newVal loDiff upDiff range img@Image{}= 
+    flip cv img $ floodHelper seed (toCvScalar newVal) (toCvScalar loDiff)
+                              (toCvScalar upDiff) range
 
 {-# INLINE floodFill #-}
diff --git a/src/OpenCV/GUI.hs b/src/OpenCV/GUI.hs
index 52b3a21..0c562e3 100644
--- a/src/OpenCV/GUI.hs
+++ b/src/OpenCV/GUI.hs
@@ -2,7 +2,7 @@
 -- and 'runNamedWindow' interfaces are the recommended entrypoints.
 module OpenCV.GUI (namedWindow, WindowFlag(..), MouseCallback, 
                    waitKey, cvInit, runWindow, runNamedWindow) where
-import OpenCV.Core.HIplImage
+import OpenCV.Core.Image
 import OpenCV.Core.HighGui
 import OpenCV.Core.CxCore (fromArr)
 import Control.Monad ((>=>))
@@ -17,20 +17,19 @@ bool _ f False = f
 
 -- |Simple window runner. Takes an action that produces images to be
 -- shown in the window. Exits when any key is pressed.
-runWindow :: (HasChannels c, ImgBuilder r) => IO (HIplImage c Word8 r) -> IO ()
+runWindow :: IO (Image c Word8 r) -> IO ()
 runWindow mkImg = newWindow 0 True >> go
-    where go = do mkImg >>= flip withHIplImage (showImage 0)
+    where go = do mkImg >>= flip withIplImage (showImage 0)
                   cvWaitKey 1 >>= bool (delWindow 0) go . (> 0)
 
 -- |Simple named window runner. Exits when any key is pressed. The
 -- name is shown in the window's title bar.
-runNamedWindow :: (HasChannels c, ImgBuilder r) => 
-                  String -> IO (HIplImage c Word8 r) -> IO ()
+runNamedWindow :: String -> IO (Image c Word8 r) -> IO ()
 runNamedWindow name mkImg = 
     do name' <- newCString name
        cvNamedWindow name' (windowFlagsToEnum [AutoSize])
        let showImg = cvShowImage name' . castPtr
-           go = do mkImg >>= flip withHIplImage showImg
+           go = do mkImg >>= flip withIplImage showImg
                    cvWaitKey 1 >>= bool (cvDestroyWindow name') go . (> 0)
        go
 
@@ -38,13 +37,12 @@ runNamedWindow name mkImg =
 -- action for showing an image, and an action for destroying the
 -- window. Be sure to repeatedly invoke 'waitKey' to keep the system
 -- alive.
-namedWindow :: (HasChannels c, HasDepth d, ImgBuilder r) => 
-               String -> [WindowFlag] -> 
+namedWindow :: String -> [WindowFlag] -> 
                --Maybe MouseCallback -> 
-               IO (HIplImage c d r -> IO (), IO ())
+               IO (Image c d r -> IO (), IO ())
 namedWindow name flags =
   do cstr <- newCString name
-     let showImg img = withHIplImage img $ \imgPtr ->
+     let showImg img = withIplImage img $ \imgPtr ->
                          cvShowImage cstr (fromArr imgPtr)
      cvNamedWindow cstr (windowFlagsToEnum flags)
      return (showImg, cvDestroyWindow cstr)
diff --git a/src/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
index ac38b61..22e4544 100644
--- a/src/OpenCV/HighCV.hs
+++ b/src/OpenCV/HighCV.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 -- |High-level Haskell bindings to OpenCV operations. Some of these
 -- operations will be performed in-place under composition. For
 -- example, @dilate 8 . erode 8@ will allocate one new image rather
@@ -9,8 +10,7 @@ module OpenCV.HighCV (
                       -- * Image Properties
                       width, height, numPixels, isColor, isMono,
                       -- * Image Construction
-                      fromPixels, fromGrayPixels, fromColorPixels, 
-                      fromPtr,
+                      fromPixels, fromGrayPixels, fromColorPixels, peekIpl,
                       -- * Image Data Accessors
                       pixels, withPixelVector, withImagePixels, 
                       sampleLine, getRect,
@@ -31,15 +31,14 @@ module OpenCV.HighCV (
                       -- * Video
                       module OpenCV.Video,
                       -- * Image types
-                      HIplImage, Monochromatic, Trichromatic, 
-                      HasChannels, HasDepth, 
+                      Image, Channels(..), HasDepth, 
                       GrayImage, ColorImage, GrayImage16, GrayImage16S,
                       Word8, Word16
     ) where
 import OpenCV.Core.CxCore
 import OpenCV.Core.CV
 import OpenCV.Drawing
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 import OpenCV.ColorConversion
 import Data.Word (Word8, Word16)
@@ -53,17 +52,17 @@ import OpenCV.FloodFill
 import OpenCV.FeatureDetection
 import OpenCV.Video
 
--- |Erode an 'HIplImage' with a 3x3 structuring element for the
--- specified number of iterations.
-erode :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
-         Int -> HIplImage c d r -> HIplImage c d r
+-- |Erode an 'Image' with a 3x3 structuring element for the specified
+-- number of iterations.
+erode :: (HasDepth d, Inplace r c d c d) =>
+         Int -> Image c d r -> Image c d r
 erode n = cv2 $ \src dst -> cvErode src dst (fromIntegral n)
 {-# INLINE erode #-}
 
--- |Dilate an 'HIplImage' with a 3x3 structuring element for the
+-- |Dilate an 'Image' with a 3x3 structuring element for the
 -- specified number of iterations.
-dilate :: (HasChannels c, HasDepth d, Inplace r c d c d) =>
-          Int -> HIplImage c d r -> HIplImage c d r
+dilate :: (HasDepth d, Inplace r c d c d) =>
+          Int -> Image c d r -> Image c d r
 dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
 {-# INLINE dilate #-}
 
@@ -71,22 +70,20 @@ dilate n = cv2 $ \src dst -> cvDilate src dst (fromIntegral n)
 -- the end points. Parameters are the two endpoints, the line
 -- connectivity to use when sampling, and an image; returns the list
 -- of pixel values.
-sampleLine :: (HasChannels c, HasDepth d, ImgBuilder r) =>
-              (Int, Int) -> (Int, Int) -> Connectivity -> HIplImage c d r -> [d]
-sampleLine pt1 pt2 conn img = unsafePerformIO . withHIplImage img $ 
-                                \p -> cvSampleLine p pt1 pt2 conn
+sampleLine :: (Int, Int) -> (Int, Int) -> Connectivity -> Image c d r -> [d]
+sampleLine pt1 pt2 conn img@Image{} = unsafePerformIO . withIplImage img $ 
+                                      \p -> cvSampleLine p pt1 pt2 conn
 {-# NOINLINE sampleLine #-}
 
 -- |Line detection in a binary image using a standard Hough
 -- transform. Parameters are @rho@, the distance resolution in
 -- pixels; @theta@, the angle resolution in radians; @threshold@, the
 -- line classification accumulator threshold; and the input image.
-houghStandard :: ImgBuilder r =>
-                 Double -> Double -> Int -> HIplImage Monochromatic Word8 r -> 
+houghStandard :: Double -> Double -> Int -> Image Monochromatic Word8 r -> 
                  [((Int, Int),(Int,Int))]
 houghStandard rho theta threshold img = unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
-       cvSeq <- withHIplImage img $ 
+       cvSeq <- withIplImage img $ 
                 \p -> cvHoughLines2 p storage 0 rho theta threshold 0 0
        hlines <- mapM (\p -> do f1 <- peek p
                                 f2 <- peek (plusPtr p (sizeOf (undefined::Float)))
@@ -114,9 +111,8 @@ houghStandard rho theta threshold img = unsafePerformIO $
 -- transform. Parameters are @rho@, the distance resolution in pixels;
 -- @theta@, the angle resolution in radians; @threshold@, the line
 -- classification accumulator threshold; and the input image.
-houghProbabilistic :: ImgBuilder r =>
-                      Double -> Double -> Int -> Double -> Double -> 
-                      HIplImage Monochromatic Word8 r -> [((Int, Int),(Int,Int))]
+houghProbabilistic :: Double -> Double -> Int -> Double -> Double -> 
+                      Image Monochromatic Word8 r -> [((Int, Int),(Int,Int))]
 houghProbabilistic rho theta threshold minLength maxGap img = 
     unsafePerformIO $
     do storage <- cvCreateMemStorage (min 0 (fromIntegral threshold))
@@ -150,16 +146,15 @@ findContours img = snd $ withDuplicateImage img $
 -- captured in the type. That said, it would be nice to be able to do
 -- in-place updates to the output of 'resize'.
 
--- |Resize the supplied 'HIplImage' to the given width and height using
+-- |Resize the supplied 'Image' to the given width and height using
 -- the supplied 'InterpolationMethod'.
-resize :: (HasChannels c, HasDepth d) => 
-          InterpolationMethod -> Int -> Int -> HIplImage c d NoROI -> 
-          HIplImage c d NoROI
-resize method w h img = 
+resize :: InterpolationMethod -> Int -> Int -> 
+          Image c d NoROI -> Image c d NoROI
+resize method w h img@Image{} = 
     unsafePerformIO $
-    do img' <- mkHIplImage w h
-       _ <- withHIplImage img $ \src ->
-              withHIplImage img' $ \dst ->
+    do img' <- mallocImage w h
+       _ <- withIplImage img $ \src ->
+              withIplImage img' $ \dst ->
                 cvResize src dst method
        return img'
 {-# NOINLINE resize #-}
@@ -167,8 +162,8 @@ resize method w h img =
 -- |Normalize the range of color values in an image to the given
 -- range. Example usage with a grayscale image is @normalize cv_MinMax
 -- 0 255 img@
-normalize :: (HasChannels c, HasDepth d, Inplace r c d c d) => 
-             ArrayNorm -> CDouble -> CDouble -> HIplImage c d r -> HIplImage c d r
+normalize :: (HasDepth d, Inplace r c d c d) => 
+             ArrayNorm -> CDouble -> CDouble -> Image c d r -> Image c d r
 normalize ntype a b = cv2 $ \img dst -> 
                       cvNormalize img dst a b (unNorm ntype) nullPtr
 {-# INLINE normalize #-}
diff --git a/src/OpenCV/Histograms.hs b/src/OpenCV/Histograms.hs
index d3c97bf..e9539fc 100644
--- a/src/OpenCV/Histograms.hs
+++ b/src/OpenCV/Histograms.hs
@@ -2,7 +2,7 @@
 module OpenCV.Histograms (equalizeHist) where
 import Foreign.Ptr (Ptr)
 import OpenCV.Core.CxCore
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 
 foreign import ccall "opencv2/imgproc/imgproc_c.h cvEqualizeHist"
diff --git a/src/OpenCV/PixelUtils.hs b/src/OpenCV/PixelUtils.hs
index e497d48..d624be6 100644
--- a/src/OpenCV/PixelUtils.hs
+++ b/src/OpenCV/PixelUtils.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, DataKinds #-}
 -- |Images obtained from OpenCV usually have the components of color
 -- pixels arranged in BGR order and pad image rows with unused
 -- bytes. This module provides mechanisms to drop the unused packing
 -- bytes.
 module OpenCV.PixelUtils where
-import OpenCV.Core.HIplImage
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.Image
+import OpenCV.Core.ImageUtil
 import OpenCV.ColorConversion (convertRGBToGray)
 import Control.Monad.ST (runST)
 import qualified Data.Vector.Storable as V
@@ -20,8 +20,8 @@ import Unsafe.Coerce (unsafeCoerce)
 -- pixel data that excludes these unused bytes. If the original image
 -- data is already packed, it is returned as a 'V.Vector' without
 -- copying.
-packPixels :: (HasChannels c, HasDepth d) => HIplImage c d NoROI -> V.Vector d
-packPixels img = 
+packPixels :: Image c d NoROI -> V.Vector d
+packPixels img@Image{} = 
     if w' == stride 
     then pixels img
     else runST $ do v <- VM.new (w*h*nc)
@@ -46,9 +46,8 @@ packPixels img =
 
 -- |Return a Vector of bytes of a single color channel from a
 -- tri-chromatic image. The desired channel must be one of 0, 1, or 2.
-isolateChannel :: HasDepth d => 
-                  Int -> HIplImage Trichromatic d NoROI -> V.Vector d
-isolateChannel ch img = 
+isolateChannel :: Int -> Image Trichromatic d NoROI -> V.Vector d
+isolateChannel ch img@Image{} = 
     if ch < 0 || ch >= 3
     then error $ "Invalid channel "++show ch++" for trichromatic image"
     else runST $ do v <- VM.new (w*h)
@@ -65,9 +64,9 @@ isolateChannel ch img =
           get = V.unsafeIndex pix
 {-# INLINE isolateChannel #-}
 
--- |Convert an 'HIplImage' \'s pixel data to a 'V.Vector' of monochromatic bytes.
-toMono :: (HasChannels c, HasDepth d, Integral d) => 
-          HIplImage c d NoROI -> V.Vector d
-toMono img = if imgChannels img == 1 then packPixels img
-             else packPixels . convertRGBToGray . isColor $ unsafeCoerce img
+-- |Convert an 'Image' \'s pixel data to a 'V.Vector' of monochromatic bytes.
+toMono :: Integral d => Image c d NoROI -> V.Vector d
+toMono img@Image{} = if imgChannels img == 1 then packPixels img
+                     else packPixels . convertRGBToGray . isColor $ 
+                          unsafeCoerce img
 
diff --git a/src/OpenCV/Threshold.hs b/src/OpenCV/Threshold.hs
index e2ca4c5..8fb6642 100644
--- a/src/OpenCV/Threshold.hs
+++ b/src/OpenCV/Threshold.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, TypeFamilies,
-             MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+             MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DataKinds #-}
 -- |Image thresholding operations. These operations will perform
 -- destructive, in-place updates when used in compositions.
 module OpenCV.Threshold (thresholdBinary, thresholdBinaryInv,
@@ -13,7 +13,7 @@ import Data.Word (Word8)
 import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr)
 import OpenCV.Core.CxCore 
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.CVOp
 
 data ThresholdType = ThreshBinary
@@ -75,8 +75,8 @@ cvThreshold1 threshold maxValue tType =
 
 -- The worker function that calls c_cvThreshold.
 cvThreshold2 :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
-                d1 -> d1 -> CInt -> HIplImage Monochromatic d1 r ->
-                HIplImage Monochromatic d2 r
+                d1 -> d1 -> CInt -> Image Monochromatic d1 r ->
+                Image Monochromatic d2 r
 cvThreshold2 threshold maxValue tType = 
     cv2 $ \src dst ->
         do _r <- c_cvThreshold src dst threshold' maxValue' tType'
@@ -92,7 +92,7 @@ cvThreshold2 threshold maxValue tType =
 -- cvThreshold = doThreshold
 cvThreshold :: (ByteOrFloat d1, SameOrByte d1 d2, Inplace r M d1 M d2) =>
                d1 -> d1 -> CInt -> 
-               HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+               Image Monochromatic d1 r -> Image Monochromatic d2 r
 cvThreshold = cvThreshold2
 
 {-# INLINE cvThreshold #-}
@@ -100,8 +100,8 @@ cvThreshold = cvThreshold2
 -- Use Otsu's method to determine an optimal threshold value which is
 -- returned along with the thresholded image.
 cvThresholdOtsu :: Inplace r M Word8 M Word8 =>
-                   Word8 -> CInt -> HIplImage Monochromatic Word8 r ->
-                   HIplImage Monochromatic Word8 r
+                   Word8 -> CInt -> Image Monochromatic Word8 r ->
+                   Image Monochromatic Word8 r
 cvThresholdOtsu maxValue tType = cvThreshold 0 maxValue tType'
     where otsu = 8
           tType' = tType .|. otsu
@@ -111,47 +111,47 @@ type M = Monochromatic
 
 -- |Binary thresholding. Parameters are the @threshold@ value, the
 -- @maxValue@ passing pixels are mapped to, and the source
--- 'HIplImage'. Each pixel greater than @threshold@ is mapped to
+-- 'Image'. Each pixel greater than @threshold@ is mapped to
 -- @maxValue@, while all others are mapped to zero.
 thresholdBinary :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                    d1 -> d1 -> 
-                   HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+                   Image Monochromatic d1 r -> Image Monochromatic d2 r
 thresholdBinary th maxValue = cvThreshold th maxValue (fromEnumC ThreshBinary)
 {-# INLINE thresholdBinary #-}
 
 -- |Inverse binary thresholding. Parameters are the @threshold@ value,
 -- the @maxValue@ passing pixels are mapped to, and the source
--- 'HIplImage'. Each pixel greater than @threshold@ is mapped to zero,
+-- 'Image'. Each pixel greater than @threshold@ is mapped to zero,
 -- while all others are mapped to @maxValue@.
 thresholdBinaryInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
                       d1 -> d1 -> 
-                      HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+                      Image Monochromatic d1 r -> Image Monochromatic d2 r
 thresholdBinaryInv th maxValue = cvThreshold th maxValue tType
     where tType = fromEnumC ThreshBinaryInv
 {-# INLINE thresholdBinaryInv #-}
 
 -- |Truncation thresholding (i.e. clamping). Parameters are the
--- @threshold@ value and the source 'HIplImage'. Maps pixels that are
+-- @threshold@ value and the source 'Image'. Maps pixels that are
 -- greater than @threshold@ to the @threshold@ value; leaves all other
 -- pixels unchanged.
 thresholdTruncate :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
-                     d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+                     d1 -> Image Monochromatic d1 r -> Image Monochromatic d2 r
 thresholdTruncate threshold = cvThreshold threshold 0 (fromEnumC ThreshTrunc)
 {-# INLINE thresholdTruncate #-}
 
 -- |Maps pixels that are less than or equal to @threshold@ to zero;
 -- leaves all other pixels unchanged. Parameters the @threshold@ value
--- and the source 'HIplImage'.
+-- and the source 'Image'.
 thresholdToZero :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
-                   d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+                   d1 -> Image Monochromatic d1 r -> Image Monochromatic d2 r
 thresholdToZero threshold = cvThreshold threshold 0 (fromEnumC ThreshToZero)
 {-# INLINE thresholdToZero #-}
 
 -- |Maps pixels that are greater than @threshold@ to zero; leaves all
 -- other pixels unchanged. Parameters the @threshold@ value and the
--- source 'HIplImage'.
+-- source 'Image'.
 thresholdToZeroInv :: (SameOrByte d1 d2, ByteOrFloat d1, Inplace r M d1 M d2) => 
-                      d1 -> HIplImage Monochromatic d1 r -> HIplImage Monochromatic d2 r
+                      d1 -> Image Monochromatic d1 r -> Image Monochromatic d2 r
 thresholdToZeroInv threshold = cvThreshold threshold 0 tType
     where tType = fromEnumC ThreshToZeroInv
 {-# INLINE thresholdToZeroInv #-}
@@ -159,10 +159,10 @@ thresholdToZeroInv threshold = cvThreshold threshold 0 tType
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ used to replace pixels that
--- pass the threshold with and the source 'HIplImage'.
+-- pass the threshold with and the source 'Image'.
 thresholdBinaryOtsu :: (Inplace r M Word8 M Word8) =>
-                       Word8 -> HIplImage Monochromatic Word8 r ->
-                       HIplImage Monochromatic Word8 r
+                       Word8 -> Image Monochromatic Word8 r ->
+                       Image Monochromatic Word8 r
 thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnumC ThreshBinary
 {-# INLINE thresholdBinaryOtsu #-}
@@ -170,22 +170,22 @@ thresholdBinaryOtsu maxValue = cvThresholdOtsu maxValue tType
 -- |Binary thresholding using Otsu's method to determine an optimal
 -- threshold value. The chosen value is returned along with the
 -- thresholded image. Takes the @maxValue@ to replace pixels that pass
--- the threshold with and the source 'HIplImage'. The sense of the
+-- the threshold with and the source 'Image'. The sense of the
 -- thresholding operation is inverted, as in 'thresholdBinaryInv'.
 thresholdBinaryOtsuInv :: (Inplace r M Word8 M Word8) =>
-                          Word8 -> HIplImage Monochromatic Word8 r ->
-                          HIplImage Monochromatic Word8 r
+                          Word8 -> Image Monochromatic Word8 r ->
+                          Image Monochromatic Word8 r
 thresholdBinaryOtsuInv maxValue = cvThresholdOtsu maxValue tType
     where tType = fromEnumC ThreshBinaryInv
 {-# INLINE thresholdBinaryOtsuInv #-}
 
 -- |Maps pixels that are greater than @threshold@ to the @threshold@
 -- value; leaves all other pixels unchanged. Takes the source
--- 'HIplImage'; the @threshold@ value is chosen using Otsu's method
+-- 'Image'; the @threshold@ value is chosen using Otsu's method
 -- and returned along with the thresholded image.
 thresholdTruncateOtsu :: (Inplace r M Word8 M Word8) =>
-                         HIplImage Monochromatic Word8 r -> 
-                         HIplImage Monochromatic Word8 r
+                         Image Monochromatic Word8 r -> 
+                         Image Monochromatic Word8 r
 thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnumC ThreshTrunc)
 {-# INLINE thresholdTruncateOtsu #-}
 
@@ -193,8 +193,8 @@ thresholdTruncateOtsu = cvThresholdOtsu 0 (fromEnumC ThreshTrunc)
 -- leaves all other pixels unchaged.The @threshold@ value is chosen
 -- using Otsu's method and returned along with the thresholded image.
 thresholdToZeroOtsu :: (Inplace r M Word8 M Word8) =>
-                       HIplImage Monochromatic Word8 r -> 
-                       HIplImage Monochromatic Word8 r
+                       Image Monochromatic Word8 r -> 
+                       Image Monochromatic Word8 r
 thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnumC ThreshToZero)
 {-# INLINE thresholdToZeroOtsu #-}
 
@@ -202,7 +202,7 @@ thresholdToZeroOtsu = cvThresholdOtsu 0 (fromEnumC ThreshToZero)
 -- other pixels unchaged.The @threshold@ value is chosen using Otsu's
 -- method and returned along with the thresholded image.
 thresholdToZeroOtsuInv :: (Inplace r M Word8 M Word8) =>
-                          HIplImage Monochromatic Word8 r -> 
-                          HIplImage Monochromatic Word8 r
+                          Image Monochromatic Word8 r -> 
+                          Image Monochromatic Word8 r
 thresholdToZeroOtsuInv = cvThresholdOtsu 0 (fromEnumC ThreshToZeroInv)
 {-# INLINE thresholdToZeroOtsuInv #-}
diff --git a/src/OpenCV/Video.hs b/src/OpenCV/Video.hs
index 26b10e4..c10be19 100644
--- a/src/OpenCV/Video.hs
+++ b/src/OpenCV/Video.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 -- |Interfaces for grabbing images from cameras and video files, and
 -- for writing to video files.
 module OpenCV.Video (createFileCapture, createFileCaptureLoop, 
@@ -7,7 +8,7 @@ import Data.Maybe (fromMaybe)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)
 import OpenCV.Core.CxCore
-import OpenCV.Core.HIplUtil
+import OpenCV.Core.ImageUtil
 import OpenCV.Core.HighGui
 
 -- |Raise an error if 'cvQueryFrame' returns 'Nothing'; otherwise
@@ -29,36 +30,36 @@ queryFrameLoop cap = do f <- cvQueryFrame cap
 -- be used to query for the next available frame. If no frame is
 -- available either due to error or the end of the video sequence,
 -- 'Nothing' is returned.
-createFileCapture :: (HasChannels c, HasDepth d) => 
-                     FilePath -> IO (IO (Maybe (HIplImage c d NoROI)))
+createFileCapture :: (HasDepth d, SingI c) => 
+                     FilePath -> IO (IO (Maybe (Image c d NoROI)))
 createFileCapture fname = do capture <- createFileCaptureF fname
                              return (withForeignPtr capture $ \cap ->
                                        do f <- cvQueryFrame cap
                                           case f of
                                             Nothing -> return Nothing
-                                            Just f' -> Just `fmap` fromPtr f')
+                                            Just f' -> Just `fmap` peekIpl f')
 
 -- |Open a capture stream from a movie file. The returned action may
 -- be used to query for the next available frame. The sequence of
 -- frames will return to its beginning when the end of the video is
 -- encountered.
-createFileCaptureLoop :: (HasChannels c, HasDepth d) =>
-                         FilePath -> IO (IO (HIplImage c d NoROI))
+createFileCaptureLoop :: (HasDepth d, SingI c) =>
+                         FilePath -> IO (IO (Image c d NoROI))
 createFileCaptureLoop fname = do capture <- createFileCaptureF fname
                                  return (withForeignPtr capture $ 
-                                         (>>= fromPtr) . queryFrameLoop)
+                                         (>>= peekIpl) . queryFrameLoop)
 
 
 -- |Open a capture stream from a connected camera. The parameter is
 -- the index of the camera to be used, or 'Nothing' if it does not
 -- matter what camera is used. The returned action may be used to
 -- query for the next available frame.
-createCameraCapture :: (HasChannels c, HasDepth d) =>
-                       Maybe Int -> IO (IO (HIplImage c d NoROI))
+createCameraCapture :: (HasDepth d, SingI c) => 
+                       Maybe Int -> IO (IO (Image c d NoROI))
 createCameraCapture cam = do cvInit
                              capture <- createCameraCaptureF cam'
                              return (withForeignPtr capture $ 
-                                     (>>= fromPtr) . queryError)
+                                     (>>= peekIpl) . queryError)
     where cam' = fromMaybe (-1) cam
 
 -- |4-character code for MPEG-4.
@@ -70,12 +71,12 @@ mpeg4CC = ('F','M','P','4')
 -- (e.g. @(\'F\',\'M\',\'P\',\'4\')@ for MPEG-4), the framerate of the
 -- created video stream, and the size of the video frames. The
 -- returned action may be used to add frames to the video stream.
-createVideoWriter :: (HasChannels c, HasDepth d, ImgBuilder r) =>
+createVideoWriter :: (HasDepth d, UpdateROI r) =>
                      FilePath -> FourCC -> Double -> (Int,Int) -> 
-                     IO (HIplImage c d r -> IO ())
+                     IO (Image c d r -> IO ())
 createVideoWriter fname codec fps sz = 
     do writer <- createVideoWriterF fname codec fps sz
        let writeFrame img = withForeignPtr writer $ \writer' ->
-                              withHIplImage img $ \img' ->
+                              withIplImage img $ \img' ->
                                 cvWriteFrame writer' img'
        return writeFrame

From de51e2eac2c9dc525c40e24af9fbc65418126ac9 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 21 Sep 2012 15:36:58 -0400
Subject: [PATCH 123/137] Bumped base dependency to 4.6.

This version of the library now needs GHC 7.6.1 or newer, so the base
dependency is a signal that older GHC/base combinations won't work.
---
 HOpenCV.cabal | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index dab653d..f67f8b2 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -12,11 +12,11 @@ description:
    .
    /Installation/
    .
-   You must install OpenCV (development packages) prior to installing this package. Currently tested on Ubuntu Linux 11.04, Mac OS 10.5 and 10.6, Windows 7.
+   You must install OpenCV (development packages) prior to installing this package. Currently tested on Mac OS 10.7.
    .
    /Usage/
    .
-   The "OpenCV.HighCV" module exposes the most commonly used functionality. Other modules not in the @Core@ directory provide specific types of operations. While the @Core@ modules contain to low-level OpenCV interfaces.
+   The "OpenCV.HighCV" module exposes the most commonly used functionality. The @Core@ modules contain to low-level OpenCV interfaces, while modules not in the @Core@ directory provide specific types of operations.
    .
    See @src\/Examples\/VideoFunhouse@ for an example application.
 build-type:         Custom
@@ -79,7 +79,7 @@ library
        extra-libraries: cv highgui
      else
        extra-libraries: opencv_core,opencv_imgproc,opencv_highgui,opencv_video
-   build-depends: base >=4 && <5, 
+   build-depends: base >= 4.6 && <5, 
                   template-haskell,
                   vector-space >= 0.7.2,
                   directory >= 1.0.1.0 && < 2,

From 5a34f78a94a182ebf6977737fa90adac6907d24d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 21 Sep 2012 17:58:12 -0400
Subject: [PATCH 124/137] Some API renaming. Mutable image dup helper.

---
 HOpenCV.cabal                |  2 +-
 src/OpenCV/Core/Image.hsc    | 41 ++++++++++++++++++++----------------
 src/OpenCV/Core/ImageUtil.hs | 33 +++++++++++++++++++----------
 src/OpenCV/HighCV.hs         |  4 ++--
 src/OpenCV/PixelUtils.hs     |  6 +++---
 5 files changed, 51 insertions(+), 35 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index f67f8b2..3dacc79 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,5 +1,5 @@
 name: HOpenCV
-version: 0.3.0
+version: 0.3.1
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc
index 63d1345..b608565 100644
--- a/src/OpenCV/Core/Image.hsc
+++ b/src/OpenCV/Core/Image.hsc
@@ -184,14 +184,14 @@ bytesPerPixel = (`div` 8) . fromIntegral . unSign . unDepth . depth
 -- region-of-interest (ROI) set ('HasROI' or 'NoROI').
 data Image (c::Channels) d (r::ROIEnabled) where
   Image :: (SingI c, HasDepth d, SingI r, UpdateROI r) => 
-           { origin :: !CInt
-           , width :: !CInt
-           , height :: !CInt
-           , roi :: !(Maybe CvRect)
-           , imageSize :: !CInt
-           , imageData :: !(ForeignPtr d)
+           { origin          :: !Int
+           , width           :: !Int
+           , height          :: !Int
+           , roi             :: !(Maybe CvRect)
+           , imageSize       :: !Int
+           , imageData       :: !(ForeignPtr d)
            , imageDataOrigin :: !(ForeignPtr d)
-           , widthStep :: !CInt
+           , widthStep       :: !Int
            } -> Image c d r
 
 
@@ -262,6 +262,12 @@ withIplImage img@(Image{}) f = alloca $ \p ->
                                               (\hp -> do pokeIpl img p (castPtr hp)
                                                          withROI img p f)
 
+h2c :: Int -> CInt
+h2c = fromIntegral
+
+c2h :: CInt -> Int
+c2h = fromIntegral
+
 -- |Read a 'Image' from a 'Ptr' 'IplImage'
 peekIpl :: (SingI c, HasDepth d, SingI r, UpdateROI r) => 
            Ptr IplImage -> IO (Image c d r)
@@ -278,20 +284,19 @@ pokeIpl himg ptr hp =
        (#poke IplImage, nChannels) ptr (numChannels (Proxy::Proxy c))
        (#poke IplImage, depth) ptr (unDepth (depth (undefined::d)))
        (#poke IplImage, dataOrder) ptr (0::Int)
-       (#poke IplImage, origin) ptr (origin himg)
-       (#poke IplImage, align) ptr (4::Int)
-       (#poke IplImage, width) ptr (width himg)
-       (#poke IplImage, height) ptr (height himg)
+       (#poke IplImage, origin) ptr (h2c $ origin himg)
+       (#poke IplImage, align) ptr (4::CInt)
+       (#poke IplImage, width) ptr (h2c $ width himg)
+       (#poke IplImage, height) ptr (h2c $ height himg)
        (#poke IplImage, roi) ptr nullPtr
        (#poke IplImage, maskROI) ptr nullPtr
        (#poke IplImage, imageId) ptr nullPtr
        (#poke IplImage, tileInfo) ptr nullPtr
-       (#poke IplImage, imageSize) ptr (imageSize himg)
+       (#poke IplImage, imageSize) ptr (h2c $ imageSize himg)
        (#poke IplImage, imageData) ptr hp
-       (#poke IplImage, widthStep) ptr (widthStep himg)
+       (#poke IplImage, widthStep) ptr (h2c $ widthStep himg)
        (#poke IplImage, imageDataOrigin) ptr hp
 
-
 foreign import ccall "HOpenCV_wrap.h c_cvGetROI"
   c_cvGetImageROI :: Ptr IplImage -> Ptr CInt -> IO ()
 
@@ -334,16 +339,16 @@ instance forall c d r. (SingI c, HasDepth d, SingI r, UpdateROI r) =>
     alignment _ = alignment (undefined :: CDouble)
     poke = error "Poking a 'Ptr Image' is unsafe."
     peek ptr = do
-      numChannels' <- (#peek IplImage, nChannels) ptr :: IO CInt
+      numChannels' <- c2h <$> (#peek IplImage, nChannels) ptr
       depth' <- Depth <$> (#peek IplImage, depth) ptr
-      width' <- (#peek IplImage, width) ptr
-      height' <- (#peek IplImage, height) ptr
+      width' <- c2h <$> (#peek IplImage, width) ptr
+      height' <- c2h <$> (#peek IplImage, height) ptr
       roir <- (#peek IplImage, roi) ptr >>= maybePeekROI (castPtr ptr)
       when (depth' /= (depth (undefined::d)))
            (error $ "IplImage has depth "++show depth'++
                     " but desired Image has depth "++
                     show (depth (undefined::d)))
-      if numChannels (Proxy::Proxy c) /= fromIntegral numChannels'
+      if numChannels (Proxy::Proxy c) /= numChannels'
         then do img2' <- mallocImage width' height' :: IO (Image c d NoROI)
                 let img2 = updateROI roir img2' :: Image c d r
                 let conv = if numChannels' == 1 
diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index 8e679f0..78af45d 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -2,7 +2,7 @@
              FlexibleInstances, DataKinds, KindSignatures #-}
 -- |Functions for working with 'HIplImage's.
 module OpenCV.Core.ImageUtil
-    (isColor, isMono, imgChannels, withPixelVector, pixels,
+    (isColor, isMono, imgChannels, withPixelVector, pixelVector,
      peekIpl, fromFileColor, fromFileGray, fromPGM16, toFile, 
      compatibleImage, duplicateImage, fromPixels,
      withImagePixels, fromGrayPixels, fromColorPixels,
@@ -10,7 +10,7 @@ module OpenCV.Core.ImageUtil
      mkImage, mallocImage, numPixels, blackImage, Image(..), 
      ROIEnabled(..), withIplImage, Channels(..), 
      GrayImage, GrayImage16, GrayImage16S, ColorImage, 
-     c_cvSetImageROI, c_cvResetImageROI,
+     withDuplicatePixels, c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), CvScalarT, AsCvScalar(..), ScalarOK,
      colorDepth, UpdateROI, SingI,
      ByteOrFloat, getRect, fromFile, unsafeWithHIplImage,
@@ -26,6 +26,7 @@ import Control.Monad (when, unless, join)
 import Data.Int (Int16)
 import Data.Proxy
 import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as VM
 import Data.Singletons (SingI)
 import Data.Word (Word8, Word16)
 import Foreign.ForeignPtr
@@ -90,18 +91,28 @@ withImagePixels :: Image c d NoROI -> (V.Vector d -> r) -> r
 withImagePixels img@Image{} f = f $ V.unsafeFromForeignPtr (imageData img) 0 n
     where n = fromIntegral (imageSize img) `div` colorDepth img
 
+-- |Apply the supplied function to a mutable 'VM.IOVector' containing
+-- a copy of the pixel data from the input image. Returns the new
+-- image and any result of the 'IO' action.
+withDuplicatePixels :: Image c d NoROI -> (VM.IOVector d -> IO r) -> 
+                       IO (Image c d NoROI, r)
+withDuplicatePixels img1@Image{} f = do img2 <- duplicateImage img1
+                                        let ptr = imageDataOrigin img2
+                                        r <- f $ VM.unsafeFromForeignPtr0 ptr n
+                                        return (img2, r)
+  where n = numPixels img1 * imgChannels img1
+
 -- |Return a 'V.Vector' containing a copy of the pixels that make up a
 -- 'HIplImage'.
-pixels :: Storable d => Image c d NoROI -> V.Vector d
-pixels img = unsafePerformIO $ 
-             do ptr <- mallocForeignPtrBytes len
-                withForeignPtr ptr $ \dst -> 
-                    withForeignPtr (imageData img) $ \src -> 
-                        copyBytes dst src len
-                return $ V.unsafeFromForeignPtr ptr 0 len
+pixelVector :: Storable d => Image c d NoROI -> V.Vector d
+pixelVector img = unsafePerformIO $ 
+                  do ptr <- mallocForeignPtrBytes len
+                     withForeignPtr ptr $ \dst -> 
+                       withForeignPtr (imageData img) $ \src -> 
+                         copyBytes dst src len
+                     return $ V.unsafeFromForeignPtr ptr 0 len
     where len = fromIntegral $ imageSize img
-{-# NOINLINE pixels #-}
-
+{-# NOINLINE pixelVector #-}
 
 -- Ensure that a file exists.
 checkFile :: FilePath -> IO ()
diff --git a/src/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
index 22e4544..5d17468 100644
--- a/src/OpenCV/HighCV.hs
+++ b/src/OpenCV/HighCV.hs
@@ -12,8 +12,8 @@ module OpenCV.HighCV (
                       -- * Image Construction
                       fromPixels, fromGrayPixels, fromColorPixels, peekIpl,
                       -- * Image Data Accessors
-                      pixels, withPixelVector, withImagePixels, 
-                      sampleLine, getRect,
+                      pixelVector, withPixelVector, withImagePixels, 
+                      withDuplicatePixels, sampleLine, getRect,
                       -- * Image Processing
                       erode, dilate, houghStandard, houghProbabilistic, 
                       normalize, resize, setROI, resetROI,
diff --git a/src/OpenCV/PixelUtils.hs b/src/OpenCV/PixelUtils.hs
index d624be6..f7513c0 100644
--- a/src/OpenCV/PixelUtils.hs
+++ b/src/OpenCV/PixelUtils.hs
@@ -23,7 +23,7 @@ import Unsafe.Coerce (unsafeCoerce)
 packPixels :: Image c d NoROI -> V.Vector d
 packPixels img@Image{} = 
     if w' == stride 
-    then pixels img
+    then pixelVector img
     else runST $ do v <- VM.new (w*h*nc)
                     let sliceSrc x = V.unsafeSlice x w' pix
                         sliceDst x = VM.unsafeSlice x w' v
@@ -41,7 +41,7 @@ packPixels img@Image{} =
           nc = imgChannels img
           w' = w * nc
           stride = fromIntegral $ widthStep img
-          pix = pixels img
+          pix = pixelVector img
 {-# INLINE packPixels #-}
 
 -- |Return a Vector of bytes of a single color channel from a
@@ -60,7 +60,7 @@ isolateChannel ch img@Image{} =
     where w = fromIntegral $ width img
           h = fromIntegral $ height img
           margin = fromIntegral (widthStep img) - (w  * 3)
-          pix = pixels img
+          pix = pixelVector img
           get = V.unsafeIndex pix
 {-# INLINE isolateChannel #-}
 

From cfe835ca2d6e55ad8bdfc64d00390d27bab25033 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Tue, 25 Sep 2012 17:54:41 -0400
Subject: [PATCH 125/137] Added helpers for working with 8bpp RGB pixels.

---
 HOpenCV.cabal                |  1 +
 src/OpenCV/Color.hs          | 25 +++++++++++++++++++++++++
 src/OpenCV/Core/ImageUtil.hs | 15 ++++++++++++++-
 src/OpenCV/HighCV.hs         |  4 +++-
 4 files changed, 43 insertions(+), 2 deletions(-)
 create mode 100644 src/OpenCV/Color.hs

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 3dacc79..7aa0ebe 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -60,6 +60,7 @@ library
       OpenCV.Filtering
       OpenCV.FeatureDetection
       OpenCV.Histograms
+      OpenCV.Color
    c-sources:
       src/OpenCV/Core/HOpenCV_wrap.c
       src/OpenCV/ArrayOps_hsc.c
diff --git a/src/OpenCV/Color.hs b/src/OpenCV/Color.hs
new file mode 100644
index 0000000..0f94b4d
--- /dev/null
+++ b/src/OpenCV/Color.hs
@@ -0,0 +1,25 @@
+-- |A convenient 8-bit-per-channel RGB data type with a 'Storable'
+-- instance.
+module OpenCV.Color where
+import Control.Applicative
+import Data.Word (Word8)
+import Foreign.Ptr (castPtr)
+import Foreign.Storable (Storable(..))
+
+data RGB8 = RGB8 {-# UNPACK #-} !Word8
+                 {-# UNPACK #-} !Word8
+                 {-# UNPACK #-} !Word8
+
+instance Storable RGB8 where
+  sizeOf _ = 3
+  alignment _ = 4
+  peek ptr = RGB8 <$> peek ptr' <*> peekElemOff ptr' 1 <*> peekElemOff ptr' 2
+    where ptr' = castPtr ptr
+  poke ptr (RGB8 r g b) = do poke ptr' r
+                             pokeElemOff ptr' 1 g
+                             pokeElemOff ptr' 2 b
+    where ptr' = castPtr ptr
+
+-- |Map a function over each component of an RGB triple.
+rgbmap :: (Word8 -> Word8) -> RGB8 -> RGB8
+rgbmap f (RGB8 r g b) = RGB8 (f r) (f g) (f b)
diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index 78af45d..4c29399 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -12,7 +12,7 @@ module OpenCV.Core.ImageUtil
      GrayImage, GrayImage16, GrayImage16S, ColorImage, 
      withDuplicatePixels, c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), CvScalarT, AsCvScalar(..), ScalarOK,
-     colorDepth, UpdateROI, SingI,
+     colorDepth, UpdateROI, SingI, withDuplicateRGBPixels,
      ByteOrFloat, getRect, fromFile, unsafeWithHIplImage,
      duplicateImagePtr, compatibleImagePtr, compatibleImagePtrPtr) where
 import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF,
@@ -20,6 +20,7 @@ import OpenCV.Core.CxCore (IplImage, cvFree, cvFreePtr, createImageF,
                            getNumChannels, getDepth, cvGetSize)
 import OpenCV.Core.HighGui (cvLoadImage, cvSaveImage, LoadColor(..))
 import OpenCV.Core.Image
+import OpenCV.Color
 import Control.Applicative
 import Control.Arrow (second, (***))
 import Control.Monad (when, unless, join)
@@ -102,6 +103,18 @@ withDuplicatePixels img1@Image{} f = do img2 <- duplicateImage img1
                                         return (img2, r)
   where n = numPixels img1 * imgChannels img1
 
+-- |Specialization of 'withDuplicatePixels' to ease the common case of
+-- dealing with 8 bit triples for each pixel.
+withDuplicateRGBPixels :: Image Trichromatic Word8 NoROI -> 
+                          (VM.IOVector RGB8 -> IO r) -> 
+                          IO (Image Trichromatic Word8 NoROI, r)
+withDuplicateRGBPixels img1 f = do img2 <- duplicateImage img1
+                                   let ptr = castForeignPtr $ 
+                                             imageDataOrigin img2
+                                   r <- f $ VM.unsafeFromForeignPtr0 ptr n
+                                   return (img2, r)
+  where n = numPixels img1
+
 -- |Return a 'V.Vector' containing a copy of the pixels that make up a
 -- 'HIplImage'.
 pixelVector :: Storable d => Image c d NoROI -> V.Vector d
diff --git a/src/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
index 5d17468..2f467e8 100644
--- a/src/OpenCV/HighCV.hs
+++ b/src/OpenCV/HighCV.hs
@@ -14,6 +14,7 @@ module OpenCV.HighCV (
                       -- * Image Data Accessors
                       pixelVector, withPixelVector, withImagePixels, 
                       withDuplicatePixels, sampleLine, getRect,
+                      withDuplicateRGBPixels, RGB8(..), rgbmap,
                       -- * Image Processing
                       erode, dilate, houghStandard, houghProbabilistic, 
                       normalize, resize, setROI, resetROI,
@@ -33,7 +34,7 @@ module OpenCV.HighCV (
                       -- * Image types
                       Image, Channels(..), HasDepth, 
                       GrayImage, ColorImage, GrayImage16, GrayImage16S,
-                      Word8, Word16
+                      Word8, Word16, RGB8
     ) where
 import OpenCV.Core.CxCore
 import OpenCV.Core.CV
@@ -46,6 +47,7 @@ import Foreign.C.Types (CDouble)
 import Foreign.Ptr
 import Foreign.Storable
 import System.IO.Unsafe (unsafePerformIO)
+import OpenCV.Color
 import OpenCV.GUI
 import OpenCV.Threshold
 import OpenCV.FloodFill

From 6a4c6cb1f57734b3743d00206e9fca29e58c7e9f Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 12 Oct 2012 18:15:59 -0400
Subject: [PATCH 126/137] Fixed a comment bug.

---
 src/OpenCV/Core/ImageUtil.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index 4c29399..74df8d6 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -267,8 +267,7 @@ withPixelVector w h pix f = if len == sz
                          _ -> error "fromPixels non-zero offset"
 
 -- |Construct a fresh 'Image' from a width, a height, and a 'V.Vector'
--- of pixel values. The returned 'Image' shares the underlying
--- 'V.Vector'\'s data.
+-- of pixel values.
 fromPixels :: forall a c d. (Integral a, SingI c, HasDepth d) =>
               a -> a -> V.Vector d -> Image c d NoROI
 fromPixels w h pix = unsafePerformIO $ 

From 59a7f3f5c71d3c40d3ae6aabb4ac43a7432e59c0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 12 Oct 2012 19:11:31 -0400
Subject: [PATCH 127/137] Small code simplification.

---
 src/OpenCV/Core/ImageUtil.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index 74df8d6..c6f6e24 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -273,12 +273,11 @@ fromPixels :: forall a c d. (Integral a, SingI c, HasDepth d) =>
 fromPixels w h pix = unsafePerformIO $ 
                      do fp <- copyData
                         return $ mkImage w h fp
-    where copyData = let (vfp,offset,len) = V.unsafeToForeignPtr pix
+    where copyData = let (vfp,len) = V.unsafeToForeignPtr0 pix
                      in do fp <- mallocForeignPtrBytes len
                            withForeignPtr vfp $ \src -> 
                              withForeignPtr fp $ \dst -> 
-                               let src' = plusPtr src offset
-                               in copyBytes dst src' len
+                               copyBytes dst src len
                            return fp
 {-# INLINE [0] fromPixels #-}
 

From ded391b8ac18e4998f60ed3aa85781e8568e879d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Thu, 29 Nov 2012 17:32:00 -0500
Subject: [PATCH 128/137] Restrict cv2 INLINE phase.

---
 src/OpenCV/Core/CVOp.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/OpenCV/Core/CVOp.hs b/src/OpenCV/Core/CVOp.hs
index 518917c..45fc6b3 100644
--- a/src/OpenCV/Core/CVOp.hs
+++ b/src/OpenCV/Core/CVOp.hs
@@ -92,48 +92,48 @@ class (HasDepth d1, HasDepth d2, SingI c2) =>
   cv2 :: IplArrayType e =>
            (Ptr e -> Ptr e -> IO a) -> Image c1 d1 r -> Image c2 d2 r
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 -- | We clone an image and operate within its ROI if the source and
 -- destination images are compatible (same number of channels and
 -- pixel depth).
 instance (c1~c2, HasDepth d, SingI c2) => Inplace HasROI c1 d c2 d where
   cv2 = cv . dupArg
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance (HasDepth d1, HasDepth d2) => 
          Inplace HasROI Trichromatic d1 Monochromatic d2 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance (HasDepth d1, HasDepth d2) => 
          Inplace HasROI Monochromatic d1 Trichromatic d2 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance SingI c2 => Inplace HasROI c1 Word8 c2 Float where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance SingI c2 => Inplace HasROI c1 Word8 c2 Word16 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance SingI c2 => Inplace HasROI c1 Word8 c2 Double where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance SingI c2 => Inplace HasROI c1 Word16 c2 Word8 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance SingI c2 => Inplace HasROI c1 Float c2 Word8 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 instance (HasDepth d1, HasDepth d2, SingI c2) => Inplace NoROI c1 d1 c2 d2 where
   cv2 = cv2Alloc
-  {-# INLINE cv2 #-}
+  {-# INLINE [1] cv2 #-}
 
 -- If the source and destination are not compatible, then it doesn't
 -- matter if there is a ROI set as we can never operate in-place.

From 95add599ce03ad3e441c10678f2838cc07d5fdd0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Thu, 29 Nov 2012 20:31:42 -0500
Subject: [PATCH 129/137] Fixed pixelVector.

Added unsafePixelVector to return a Vector that shares storage with an
Image.

Added a type synonym for monochromatic floating point images.
---
 src/OpenCV/Core/ImageUtil.hs | 26 +++++++++++++++++++-------
 src/OpenCV/HighCV.hs         |  8 ++++----
 2 files changed, 23 insertions(+), 11 deletions(-)

diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index c6f6e24..f597871 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -2,14 +2,14 @@
              FlexibleInstances, DataKinds, KindSignatures #-}
 -- |Functions for working with 'HIplImage's.
 module OpenCV.Core.ImageUtil
-    (isColor, isMono, imgChannels, withPixelVector, pixelVector,
+    (isColor, isMono, imgChannels, withPixelVector, pixelVector, 
      peekIpl, fromFileColor, fromFileGray, fromPGM16, toFile, 
-     compatibleImage, duplicateImage, fromPixels,
+     compatibleImage, duplicateImage, fromPixels, unsafePixelVector,
      withImagePixels, fromGrayPixels, fromColorPixels,
      withDuplicateImage, withCompatibleImage, setROI, resetROI,
      mkImage, mallocImage, numPixels, blackImage, Image(..), 
      ROIEnabled(..), withIplImage, Channels(..), 
-     GrayImage, GrayImage16, GrayImage16S, ColorImage, 
+     GrayImage, GrayImage16, GrayImage16S, GrayImageF, ColorImage,
      withDuplicatePixels, c_cvSetImageROI, c_cvResetImageROI,
      HasDepth(..), CvScalarT, AsCvScalar(..), ScalarOK,
      colorDepth, UpdateROI, SingI, withDuplicateRGBPixels,
@@ -53,6 +53,9 @@ type GrayImage16 = Image Monochromatic Word16 NoROI
 -- |Grayscale signed 16-bit (per-pixel) image type.
 type GrayImage16S = Image Monochromatic Int16 NoROI
 
+-- |Grayscale single precision floating point image type.
+type GrayImageF = Image Monochromatic Float NoROI
+
 -- |Color 8-bit (per-color) image type.
 type ColorImage = Image Trichromatic Word8 NoROI
 
@@ -115,18 +118,27 @@ withDuplicateRGBPixels img1 f = do img2 <- duplicateImage img1
                                    return (img2, r)
   where n = numPixels img1
 
--- |Return a 'V.Vector' containing a copy of the pixels that make up a
--- 'HIplImage'.
-pixelVector :: Storable d => Image c d NoROI -> V.Vector d
+-- |Return a 'V.Vector' containing a copy of the pixels that make up
+-- an 'Image'.
+pixelVector :: forall c d. (HasDepth d, Storable d) => 
+               Image c d NoROI -> V.Vector d
 pixelVector img = unsafePerformIO $ 
                   do ptr <- mallocForeignPtrBytes len
                      withForeignPtr ptr $ \dst -> 
                        withForeignPtr (imageData img) $ \src -> 
                          copyBytes dst src len
-                     return $ V.unsafeFromForeignPtr ptr 0 len
+                     return $ V.unsafeFromForeignPtr0 ptr n
     where len = fromIntegral $ imageSize img
+          n = len `quot` bytesPerPixel (undefined::d)
 {-# NOINLINE pixelVector #-}
 
+-- |Return a 'V.Vector' pointing to the pixels that make up an
+-- 'Image'.
+unsafePixelVector :: forall c d. (HasDepth d, Storable d) => 
+                     Image c d NoROI -> V.Vector d
+unsafePixelVector img = V.unsafeFromForeignPtr0 (imageData img) n
+  where n = imageSize img `quot` bytesPerPixel (undefined::d)
+
 -- Ensure that a file exists.
 checkFile :: FilePath -> IO ()
 checkFile f = do e <- doesFileExist f
diff --git a/src/OpenCV/HighCV.hs b/src/OpenCV/HighCV.hs
index 2f467e8..271e227 100644
--- a/src/OpenCV/HighCV.hs
+++ b/src/OpenCV/HighCV.hs
@@ -12,8 +12,8 @@ module OpenCV.HighCV (
                       -- * Image Construction
                       fromPixels, fromGrayPixels, fromColorPixels, peekIpl,
                       -- * Image Data Accessors
-                      pixelVector, withPixelVector, withImagePixels, 
-                      withDuplicatePixels, sampleLine, getRect,
+                      pixelVector, unsafePixelVector, withPixelVector, 
+                      withImagePixels, withDuplicatePixels, sampleLine, getRect,
                       withDuplicateRGBPixels, RGB8(..), rgbmap,
                       -- * Image Processing
                       erode, dilate, houghStandard, houghProbabilistic, 
@@ -33,8 +33,8 @@ module OpenCV.HighCV (
                       module OpenCV.Video,
                       -- * Image types
                       Image, Channels(..), HasDepth, 
-                      GrayImage, ColorImage, GrayImage16, GrayImage16S,
-                      Word8, Word16, RGB8
+                      GrayImage, ColorImage, GrayImage16, GrayImage16S, 
+                      GrayImageF, Word8, Word16, RGB8
     ) where
 import OpenCV.Core.CxCore
 import OpenCV.Core.CV

From 8557b99eb82eb9570d0131e164e007e5550f7f3d Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Wed, 5 Dec 2012 17:10:15 -0500
Subject: [PATCH 130/137] Improved withPixelVector usability.

Changed argument order on withPixelVector to take the Vector last.
---
 HOpenCV.cabal                | 2 +-
 src/OpenCV/Core/ImageUtil.hs | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index 7aa0ebe..e6ba6c0 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -1,5 +1,5 @@
 name: HOpenCV
-version: 0.3.1
+version: 0.4.0
 license: BSD3
 author: Noam Lewis <jones.noamle@gmail.com>
 maintainer: Anthony Cowley <acowley@gmail.com>
diff --git a/src/OpenCV/Core/ImageUtil.hs b/src/OpenCV/Core/ImageUtil.hs
index f597871..fedbf33 100644
--- a/src/OpenCV/Core/ImageUtil.hs
+++ b/src/OpenCV/Core/ImageUtil.hs
@@ -269,8 +269,8 @@ duplicateImagePtr = flip withIplImage cloneImageF
 -- lets the user apply a function on 'Image's to a 'V.Vector' of pixel
 -- data.
 withPixelVector :: forall a c d r. (HasDepth d, Integral a, SingI c) =>
-                   a -> a -> V.Vector d -> (Image c d NoROI -> r) -> r
-withPixelVector w h pix f = if len == sz
+                   a -> a -> (Image c d NoROI -> r) -> V.Vector d -> r
+withPixelVector w h f pix = if len == sz
                             then f $ mkImage w h fp
                             else error "Length disagreement"
     where sz = fromIntegral (w * h) * numChannels (Proxy::Proxy c)

From 0ad8f8fcefbfbb475ca7e998db8add9495a35bd0 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 6 Sep 2013 20:31:13 -0400
Subject: [PATCH 131/137] Fixed bug in peeking an IplImage.

Certain parameters, like origin, were not being properly loaded from the
C structure into Haskell.
---
 src/OpenCV/Core/Image.hsc | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc
index b608565..b6fe55b 100644
--- a/src/OpenCV/Core/Image.hsc
+++ b/src/OpenCV/Core/Image.hsc
@@ -279,11 +279,11 @@ peekIpl = peek . castPtr
 pokeIpl :: forall c d r. (SingI c, HasDepth d) => 
            Image (c::Channels) d r -> Ptr IplImage -> Ptr Word8 -> IO ()
 pokeIpl himg ptr hp =
-    do (#poke IplImage, nSize) ptr ((#size IplImage)::Int)
-       (#poke IplImage, ID) ptr (0::Int)
-       (#poke IplImage, nChannels) ptr (numChannels (Proxy::Proxy c))
+    do (#poke IplImage, nSize) ptr ((#size IplImage)::CInt)
+       (#poke IplImage, ID) ptr (0::CInt)
+       (#poke IplImage, nChannels) ptr (h2c $ numChannels (Proxy::Proxy c))
        (#poke IplImage, depth) ptr (unDepth (depth (undefined::d)))
-       (#poke IplImage, dataOrder) ptr (0::Int)
+       (#poke IplImage, dataOrder) ptr (0::CInt)
        (#poke IplImage, origin) ptr (h2c $ origin himg)
        (#poke IplImage, align) ptr (4::CInt)
        (#poke IplImage, width) ptr (h2c $ width himg)
@@ -360,10 +360,10 @@ instance forall c d r. (SingI c, HasDepth d, SingI r, UpdateROI r) =>
                                                        conv
                 (#peek IplImage, imageDataOrigin) ptr >>= cvFree
                 return $ unsafeCoerce img2
-        else do origin' <- (#peek IplImage, origin) ptr
-                imageSize' <- (#peek IplImage, imageSize) ptr
+        else do origin' <- c2h <$> (#peek IplImage, origin) ptr
+                imageSize' <- c2h <$> (#peek IplImage, imageSize) ptr
                 imageData' <- (#peek IplImage, imageData) ptr >>= newForeignPtr_
                 imageDataOrigin' <- (#peek IplImage, imageDataOrigin) ptr >>= newForeignPtr_
-                widthStep' <- (#peek IplImage, widthStep) ptr
+                widthStep' <- c2h <$> (#peek IplImage, widthStep) ptr
                 return $ Image origin' width' height' roir imageSize'
                                imageData' imageDataOrigin' widthStep'

From ed52fec7584bc0e214e09f0c9759143f21712583 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Fri, 6 Sep 2013 21:14:39 -0400
Subject: [PATCH 132/137] use a wrapper for cvCreateVideoWriter using cvSize

supposedly the old way (two CInt arguments) used to work in some cases,
but this did not work (cvVideoWriter returned a null pointer) for
my system. Note that there are similar wrappers pre-existing
in HOpenCV_wrap.c
---
 src/OpenCV/Core/HOpenCV_wrap.c |  8 ++++++++
 src/OpenCV/Core/HOpenCV_wrap.h |  3 +++
 src/OpenCV/Core/HighGui.hsc    | 21 ++++++++++++++-------
 3 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/src/OpenCV/Core/HOpenCV_wrap.c b/src/OpenCV/Core/HOpenCV_wrap.c
index 5abc07c..8b6f9e9 100644
--- a/src/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/OpenCV/Core/HOpenCV_wrap.c
@@ -111,6 +111,14 @@ void dilate(const CvArr *src, CvArr *dest, int iterations)
     cvDilate(src, dest, NULL, iterations);
 }
 
+CvVideoWriter* cvCreateVideoWriter2( const char* filename, int fourcc,
+                                           double fps, int frame_x, int frame_y,
+                                           int is_color CV_DEFAULT(1))
+{
+    return cvCreateVideoWriter(filename, fourcc, fps, cvSize(frame_x, frame_y), is_color);
+}
+
+
 /**********************************************************/
 
 void release_mem_storage(CvMemStorage *mem_store)
diff --git a/src/OpenCV/Core/HOpenCV_wrap.h b/src/OpenCV/Core/HOpenCV_wrap.h
index a85d924..f6faf58 100644
--- a/src/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/OpenCV/Core/HOpenCV_wrap.h
@@ -31,6 +31,9 @@ void cv_free(void *obj);
 int seq_total(const CvSeq *seq);
 /* CvRect *c_rect_cvGetSeqElem(const CvSeq *seq, int index); */
 
+CvVideoWriter* cvCreateVideoWriter(const char* filename, int fourcc, 
+        double fps, int frame_x, int frame_y, int is_color);
+
 void c_cvRectangle(CvArr *img, int x, int y, int width, int height);
 
 void c_cvLine(CvArr *img, int x1, int y1, int x2, int y2, double r, double g, 
diff --git a/src/OpenCV/Core/HighGui.hsc b/src/OpenCV/Core/HighGui.hsc
index c31e25a..4c52a1b 100644
--- a/src/OpenCV/Core/HighGui.hsc
+++ b/src/OpenCV/Core/HighGui.hsc
@@ -21,6 +21,8 @@ import Foreign.C.String
 import Data.List (foldl') 
 import OpenCV.Core.CxCore
 
+import Foreign.Marshal.Array
+
 #include <opencv2/highgui/highgui_c.h>
 
 ------------------------------------------------
@@ -129,7 +131,7 @@ fourCC (a,b,c,d) = (c1 .&. 255) + shiftL (c2 .&. 255) 8 +
                    shiftL (c3 .&. 255) 16 + shiftL (c4 .&. 255) 24
     where [c1,c2,c3,c4] = map (fromIntegral . fromEnum) [a,b,c,d]
 
-foreign import ccall "opencv2/highgui/highgui_c.h cvCreateVideoWriter"
+foreign import ccall "HOpenCV_wrap.h cvCreateVideoWriter2"
   c_cvCreateVideoWriter :: CString -> CInt -> CDouble -> CInt -> CInt -> CInt ->
                            IO (Ptr CvVideoWriter)
 
@@ -138,20 +140,25 @@ foreign import ccall "HOpenCV_wrap.h &release_video_writer"
 
 cvCreateVideoWriter :: FilePath -> FourCC -> Double -> (Int, Int) -> 
                        IO (Ptr CvVideoWriter)
-cvCreateVideoWriter fname codec fps (w, h) = 
+cvCreateVideoWriter fname codec fps (w,h) = do
     withCString fname $ \str ->
         c_cvCreateVideoWriter str (fourCC codec) (realToFrac fps) 
-                              (fromIntegral w) (fromIntegral h) 1
-                              
+            (fromIntegral w) (fromIntegral h) 1
+
 -- |Create a video file writer.
 createVideoWriterF :: FilePath -> FourCC -> Double -> (Int, Int) -> 
                       IO (ForeignPtr CvVideoWriter)
-createVideoWriterF fname codec fps sz = createForeignPtr cp_release_writer $
-                                        cvCreateVideoWriter fname codec fps sz
+createVideoWriterF fname codec fps sz =
+    createForeignPtr cp_release_writer $ cvCreateVideoWriter fname codec fps sz
 
 foreign import ccall "opencv2/highgui/highgui_c.h cvWriteFrame"
   cvWriteFrame :: Ptr CvVideoWriter -> Ptr IplImage -> IO ()
 
+{-
+foreign import ccall "opencv2/core/types_c.h cvSize"
+  cvSize :: Int -> Int -> IO (Ptr ())
+-}
+
 -------------------------------------------------
 -- Windows
 foreign import ccall "HOpenCV_wrap.h new_window"
@@ -247,4 +254,4 @@ enumToEventFlags x = map fst . filter snd $
 -- Qt fonts
 -- foreign import ccall "opencv2/highgui/highgui_c.h cvFontQt"
 --   cvFontQt :: CString -> CInt -> CDouble -> CDouble -> CDouble -> 
---               CInt -> CInt -> CInt -> IO CvFont
\ No newline at end of file
+--               CInt -> CInt -> CInt -> IO CvFont

From 140812f2005440981b554cfdf1cba4b13aa24eb1 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 6 Sep 2013 21:59:39 -0400
Subject: [PATCH 133/137] Export low-level convertColor function.

---
 src/OpenCV/ColorConversion.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/OpenCV/ColorConversion.hs b/src/OpenCV/ColorConversion.hs
index e7e26eb..e550277 100644
--- a/src/OpenCV/ColorConversion.hs
+++ b/src/OpenCV/ColorConversion.hs
@@ -4,7 +4,8 @@ module OpenCV.ColorConversion
     (convertGrayToRGB, convertGrayToBGR, 
      convertBGRToGray, convertRGBToGray,
      convertBayerBgToBGR, convertBayerBgToRGB,
-     convertRGBToHSV, convertBGRToHSV, convertHSVToBGR) where
+     convertRGBToHSV, convertBGRToHSV, convertHSVToBGR,
+     convertColor) where
 import OpenCV.Core.CV
 import OpenCV.Core.ImageUtil
 import OpenCV.Core.ColorConversion

From f6cac758f03ab3ba11c835eaf511b43cbdd586d2 Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Fri, 6 Sep 2013 21:59:50 -0400
Subject: [PATCH 134/137] Add FourCC code helper.

---
 src/OpenCV/Core/HighGui.hsc | 7 ++++++-
 src/OpenCV/Video.hs         | 2 +-
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/OpenCV/Core/HighGui.hsc b/src/OpenCV/Core/HighGui.hsc
index 4c52a1b..b05facb 100644
--- a/src/OpenCV/Core/HighGui.hsc
+++ b/src/OpenCV/Core/HighGui.hsc
@@ -7,7 +7,7 @@ module OpenCV.Core.HighGui
      CapturePos(..), cvQueryFrame,
      newWindow, delWindow, showImage, cvWaitKey,
      cvConvertImage, c_debug_ipl,
-     createVideoWriterF, cvWriteFrame, FourCC,
+     createVideoWriterF, cvWriteFrame, FourCC, toFourCC,
      cvNamedWindow, cvDestroyWindow, cvShowImage, WindowFlag(..),
      MouseCallback, cvSetMouseCallback, wrapMouseCB, cvInit,
      windowFlagsToEnum, Event(..), EventFlag(..)) where
@@ -126,6 +126,11 @@ data CvVideoWriter
 
 type FourCC = (Char, Char, Char, Char)
 
+-- | Parse a four-character 'String' into a 'FourCC' code (e.g. "XVID").
+toFourCC :: String -> FourCC
+toFourCC [a,b,c,d] = (a,b,c,d)
+toFourCC c = error $ "Invalid FourCC code: "++c
+
 fourCC :: FourCC -> CInt
 fourCC (a,b,c,d) = (c1 .&. 255) + shiftL (c2 .&. 255) 8 + 
                    shiftL (c3 .&. 255) 16 + shiftL (c4 .&. 255) 24
diff --git a/src/OpenCV/Video.hs b/src/OpenCV/Video.hs
index c10be19..b57a300 100644
--- a/src/OpenCV/Video.hs
+++ b/src/OpenCV/Video.hs
@@ -3,7 +3,7 @@
 -- for writing to video files.
 module OpenCV.Video (createFileCapture, createFileCaptureLoop, 
                      createCameraCapture, createVideoWriter, 
-                     FourCC, mpeg4CC) where
+                     FourCC, toFourCC, mpeg4CC) where
 import Data.Maybe (fromMaybe)
 import Foreign.Ptr
 import Foreign.ForeignPtr (withForeignPtr)

From 77ed62b32b814373a676afb2a33be2f9523928cc Mon Sep 17 00:00:00 2001
From: Anthony Cowley <acowley@gmail.com>
Date: Mon, 9 Sep 2013 13:00:02 -0400
Subject: [PATCH 135/137] Added VideoWriter example.

Grab video from a webcam, show it on screen and write it to a compressed
video file.
---
 src/Examples/OneOffs/VideoWriter.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)
 create mode 100644 src/Examples/OneOffs/VideoWriter.hs

diff --git a/src/Examples/OneOffs/VideoWriter.hs b/src/Examples/OneOffs/VideoWriter.hs
new file mode 100644
index 0000000..169e0e9
--- /dev/null
+++ b/src/Examples/OneOffs/VideoWriter.hs
@@ -0,0 +1,16 @@
+-- | Save video from an attached webcam to compressed video on disk
+-- while also showing it on-screen.
+import OpenCV.HighCV
+import System.Exit (exitSuccess)
+
+main :: IO ()
+main = do cam <- createCameraCapture Nothing :: IO (IO ColorImage)
+          writeImg <- createVideoWriter "foo.avi" (toFourCC "XVID") 24 (640,480)
+          (showImg,close) <- namedWindow "Video Test" [AutoSize]
+          let kb 27 = close >> exitSuccess
+              kb  _ = go
+              go = do img <- cam
+                      showImg img
+                      writeImg img
+                      waitKey 1 >>= maybe go kb
+          go
\ No newline at end of file

From eccecaebeb86a847367b0bc8df8f2847cde598c7 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Thu, 1 May 2014 00:51:22 -0400
Subject: [PATCH 136/137] working contouring

---
 HOpenCV.cabal                  |   4 +
 src/OpenCV/Contours.hsc        | 207 ++++++++++++++++++++++++++-------
 src/OpenCV/Core/HOpenCV_wrap.c |  37 ++++++
 src/OpenCV/Core/HOpenCV_wrap.h |  11 ++
 src/OpenCV/Core/Image.hsc      |   3 +-
 src/OpenCV/Drawing.hsc         |   5 +-
 6 files changed, 223 insertions(+), 44 deletions(-)

diff --git a/HOpenCV.cabal b/HOpenCV.cabal
index e6ba6c0..3a2de63 100644
--- a/HOpenCV.cabal
+++ b/HOpenCV.cabal
@@ -80,6 +80,10 @@ library
        extra-libraries: cv highgui
      else
        extra-libraries: opencv_core,opencv_imgproc,opencv_highgui,opencv_video
+
+   -- needed to load in ghci-7.8 
+   cc-options: -fPIC
+
    build-depends: base >= 4.6 && <5, 
                   template-haskell,
                   vector-space >= 0.7.2,
diff --git a/src/OpenCV/Contours.hsc b/src/OpenCV/Contours.hsc
index 9ea6346..0ad9f62 100644
--- a/src/OpenCV/Contours.hsc
+++ b/src/OpenCV/Contours.hsc
@@ -1,18 +1,140 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 -- |Incomplete support for cvFindContours.
-module OpenCV.Contours (ContourMode(..), ContourMethod(..), 
-                        cvFindContours, followContourList) where
+module OpenCV.Contours (
+                        
+  -- * contour
+  Contour(..),
+  withContourList,
+  -- ** functions to use with 'withContourList'
+  cvContourArea,
+  cvContourPerimeter,
+  followPoints,
+
+  cvDrawContours,
+  -- * moments
+  cvMoments,
+  CvMoments(..),
+
+  cvGetSpatialMoment,
+  cvGetCentralMoment,
+  cvGetNormalizedCentralMoment,
+  cvGetHuMoments,
+  CvHuMoments(..),
+
+  -- * unused
+  ContourMode(..), ContourMethod(..), 
+  ) where
 import OpenCV.Core.CxCore
-import Foreign.C.Types (CInt)
-import Foreign.Ptr (Ptr, castPtr, nullPtr)
+import OpenCV.Core.ImageUtil
+import Foreign.C.Types (CInt(..))
+import Foreign.Ptr -- (Ptr, castPtr, nullPtr)
 import Foreign.Storable
-import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Alloc -- (alloca)
+import Foreign.ForeignPtr.Safe
+import Foreign.Marshal
+
+import Control.Monad
 
 #include <opencv2/core/types_c.h>
+#include <opencv2/imgproc/types_c.h>
 
 foreign import ccall "HOpenCV_wrap.h c_cvFindContours"
-  c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> 
-                      Int -> Int -> Int -> Int -> Int -> IO Int
+  c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) ->
+                      CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
+
+foreign import ccall "HOpenCV_wrap.h c_cvGetSeqPoint"
+  c_cvGetSeqPoint :: Ptr (CvSeq a) -> CInt -> Ptr CInt -> Ptr CInt -> IO ()
+
+foreign import ccall "HOpenCV_wrap.h c_cvContourArea"
+  cvContourArea :: Contour -> IO Double
+
+foreign import ccall "HOpenCV_wrap.h c_cvContourPerimeter"
+  cvContourPerimeter :: Contour -> IO Double
+
+foreign import ccall "HOpenCV_wrap.h c_cvMoments"
+  c_cvMoments :: Ptr CvArr -> Ptr CvMoments -> IO ()
+
+cvMoments :: IplArrayType a => Ptr a -> IO CvMoments
+cvMoments img = do
+    p <- mallocForeignPtrBytes (# size CvMoments )
+    withForeignPtr p (c_cvMoments (castPtr img))
+    return (CvMoments p)
+
+foreign import ccall "cvGetSpatialMoment" 
+  c_cvGetSpatialMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double
+
+cvGetSpatialMoment, cvGetCentralMoment, cvGetNormalizedCentralMoment
+  ::  CvMoments
+  -> CInt -- ^ x
+  -> CInt -- ^ y
+  -> IO Double
+cvGetSpatialMoment (CvMoments p) xord yord =
+    withForeignPtr p (\ p' -> c_cvGetSpatialMoment p' xord yord )
+
+foreign import ccall "cvGetCentralMoment" 
+  c_cvGetCentralMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double
+
+cvGetCentralMoment (CvMoments p) xord yord =
+    withForeignPtr p (\ p' -> c_cvGetCentralMoment p' xord yord )
+
+foreign import ccall "cvGetNormalizedCentralMoment" 
+  c_cvGetNormalizedCentralMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double
+
+cvGetNormalizedCentralMoment (CvMoments p) xord yord =
+    withForeignPtr p (\ p' -> c_cvGetNormalizedCentralMoment p' xord yord )
+
+foreign import ccall "cvGetHuMoments" 
+  c_cvGetHuMoments :: Ptr CvMoments -> Ptr () -> IO ()
+
+foreign import ccall "c_cvDrawContours"
+  c_cvDrawContours :: Ptr IplImage
+    -> Contour
+    -> Ptr CvScalar -- ^ RGBA external_color
+    -> Ptr CvScalar -- ^ RGBA hole_color
+    -> CInt -- max level
+    -> CInt -- thickness
+    -> CInt -- line-type
+    -> Ptr CvPoint -- offset
+    -> IO ()
+
+cvDrawContours ::
+   Ptr IplImage
+   -> Contour
+   -> CvScalar -- ^ external color
+   -> CvScalar -- ^ hole color
+   -> CInt -- ^ max level
+   -> CInt -- ^ thickness
+   -> CInt -- ^ line type
+   -> CvPoint -- ^ offset
+   -> IO ()
+cvDrawContours img contour external_color hole_color max_level thickness line_type offset =
+    with external_color $ \ec ->
+    with hole_color $ \ hc ->
+    with offset $ \offset' ->
+    c_cvDrawContours img contour ec hc max_level thickness line_type offset'
+
+
+cvGetHuMoments :: CvMoments -> IO CvHuMoments
+cvGetHuMoments (CvMoments m) = allocaBytes (# size CvHuMoments )  $ \p -> do
+    withForeignPtr m $ \m' -> c_cvGetHuMoments m' p
+    h1 <- (#peek CvHuMoments, hu1) p
+    h2 <- (#peek CvHuMoments, hu2) p
+    h3 <- (#peek CvHuMoments, hu3) p
+    h4 <- (#peek CvHuMoments, hu4) p
+    h5 <- (#peek CvHuMoments, hu5) p
+    h6 <- (#peek CvHuMoments, hu6) p
+    h7 <- (#peek CvHuMoments, hu7) p
+    return (CvHuMoments h1 h2 h3 h4 h5 h6 h7)
+
+newtype Contour = Contour (Ptr (CvSeq (CInt, CInt)))
+
+-- | abstract. Use 'cvGetSpatialMoment' etc.
+newtype CvMoments = CvMoments (ForeignPtr CvMoments)
+
+data CvHuMoments = CvHuMoments !Double !Double !Double !Double !Double !Double !Double
+                 deriving Show
 
 -- |Contour extraction mode.
 data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme
@@ -32,9 +154,11 @@ data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme
                  | CV_RETR_TREE     -- ^retrieves all of the contours
                                     -- and reconstructs the full
                                     -- hierarchy of nested contours
+                 | CV_RETR_FLOODFILL
                    deriving (Enum, Eq)
 
-data ContourMethod = CV_CHAIN_APPROX_NONE      
+data ContourMethod = CV_CHAIN_CODE -- ^ ??
+                   | CV_CHAIN_APPROX_NONE      
                    -- ^translates all of the points from the chain
                    -- code into points
 
@@ -60,41 +184,40 @@ data ContourMethod = CV_CHAIN_APPROX_NONE
 -- |The function retrieves 'CvContour's from the binary image using the
 -- algorithm Suzuki85. The contours are a useful tool for shape
 -- analysis and object detection and recognition.
-cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour]
-cvFindContours img mode method = 
-    do storage <- cvCreateMemStorage 0
-       let header = case method of
-                      --CV_CHAIN_CODE -> (#size CvChain)
-                      _ -> (#size CvContour)
-           mode' = fromEnum mode
-           method' = case method of 
-                       CV_LINK_RUNS -> if mode == CV_RETR_LIST
-                                       then fromEnum method
-                                       else error $ "CV_LINK_RUNS can only be "++
-                                                    "used with CV_RETR_LIST"
-                       _ -> fromEnum method
-       cs <- alloca $ \cseq ->
-               do _n <- alloca $ \cseq' ->
-                          poke (cseq'::Ptr (Ptr CInt)) cseq >>
-                          c_cvFindContours (fromArr img) storage (castPtr cseq')
-                                           header mode' method' 0 0
-                  putStrLn $ "Found "++show _n++" contours"
-                  followContourList (castPtr cseq)
+--
+-- only does @CV_RETR_LIST CV_CHAIN_APPROX_SIMPLE@
+--
+withContourList :: Image Monochromatic d roi -> (Contour -> IO r) -> IO [r]
+withContourList img fn = withIplImage img $ \imgPtr -> do
+       storage <- cvCreateMemStorage 0
+       cseq <- new nullPtr
+       n <- c_cvFindContours (fromArr imgPtr) storage
+                       cseq
+                       (#size CvContour)
+                       (fromIntegral (fromEnum CV_RETR_LIST))
+                       (fromIntegral (fromEnum CV_CHAIN_APPROX_SIMPLE)) 0 0
+       cs <- mapContours fn n . Contour =<< peek cseq
        cvReleaseMemStorage storage
+       free cseq
        return cs
 
--- FIXME: This is wrong. We're actually getting an array of arrays of
--- Points. Check the cvDrawContours function to see how to interpret
--- the result of c_cvFindContours.
-followContourList :: Ptr (CvSeq CvContour) -> IO [CvContour]
-followContourList = go []
-    where go acc p = if p == nullPtr
-                     then return $ reverse acc
-                     else do putStrLn "Getting element 1"
-                             n <- seqNumElems p
-                             putStrLn $ "Initial seq has "++show n++" elems"
-                             x <- peek =<< cvGetSeqElem p 1
-                             putStrLn $ "Found " ++ show x
-                             p' <- (#peek CvSeq, h_next) p
-                             go (x:acc) p'
+mapContours :: (Contour -> IO b) -> CInt -> Contour -> IO [ b ]
+mapContours fn n (Contour p0) = go [] n p0 where
+  go acc 0 p = return $ reverse acc
+  go acc n p | p == nullPtr = return $ reverse acc
+  go acc n p = do
+        b <- fn (Contour p)
+        p' <- (#peek CvSeq, h_next) p
+        go (b:acc) (n-1) p'
+
+followPoints :: Contour -> IO [(CInt, CInt)]
+followPoints (Contour p) = do
+  m <- (#peek CvSeq, total) p
+  alloca $ \x -> alloca $ \y ->
+    let go (-1) acc = return acc
+        go ni acc = do
+          c_cvGetSeqPoint p ni x y
+          xy <- liftM2 (,) (peek x) (peek y)
+          go (ni-1) (xy : acc)
+    in go ((m::CInt) - 1) []
 
diff --git a/src/OpenCV/Core/HOpenCV_wrap.c b/src/OpenCV/Core/HOpenCV_wrap.c
index 8b6f9e9..9948d25 100644
--- a/src/OpenCV/Core/HOpenCV_wrap.c
+++ b/src/OpenCV/Core/HOpenCV_wrap.c
@@ -139,6 +139,12 @@ int seq_total(const CvSeq *seq) {
     return seq->total;
 }
 
+void c_cvGetSeqPoint(const CvSeq *seq, int i, int*x, int*y) {
+  CvPoint* p = CV_GET_SEQ_ELEM( CvPoint, seq, i);
+  *x = p->x;
+  *y = p->y;
+}
+
 /* Commonly used case of CV_GET_SEQ_ELEM is CvRect-typed elements.
    The macro CV_GET_SEQ_ELEM is supposed to be faster in some cases
    than the function cvGetSeqElem. */
@@ -184,6 +190,26 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
                           method, cvPoint(offset_x,offset_y));
 }
 
+
+double c_cvContourArea( const CvArr *contour)
+{
+  return cvContourArea( contour, CV_WHOLE_SEQ, 0 );
+}
+
+
+
+void c_cvMoments( const CvArr* arr, CvMoments* moments)
+{
+  cvMoments( arr, moments, 0);
+}
+
+double c_cvContourPerimeter( const void* contour)
+{
+  cvContourPerimeter(contour);
+}
+
+// int c_cvFollowContourList
+
 void c_cvSetRoi(IplImage* img, int x, int y, int width, int height)
 {
   cvSetImageROI(img, cvRect(x,y,width,height));
@@ -205,6 +231,17 @@ void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg)
 }
 
 
+void c_cvDrawContours( CvArr * img, CvSeq* contour,
+      CvScalar * external_color,
+      CvScalar * hole_color,
+      int max_level, int max_thickness, int line_type, CvPoint * offset )
+{
+  cvDrawContours( img, contour, *external_color, *hole_color,
+        max_level, max_thickness, line_type, *offset);
+}
+
+
+
 /****************************************************************************/
 /*
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
diff --git a/src/OpenCV/Core/HOpenCV_wrap.h b/src/OpenCV/Core/HOpenCV_wrap.h
index f6faf58..67eb8be 100644
--- a/src/OpenCV/Core/HOpenCV_wrap.h
+++ b/src/OpenCV/Core/HOpenCV_wrap.h
@@ -31,6 +31,9 @@ void cv_free(void *obj);
 int seq_total(const CvSeq *seq);
 /* CvRect *c_rect_cvGetSeqElem(const CvSeq *seq, int index); */
 
+void c_cvGetSeqPoint(const CvSeq *seq, int i, int*x, int*y);
+
+
 CvVideoWriter* cvCreateVideoWriter(const char* filename, int fourcc, 
         double fps, int frame_x, int frame_y, int is_color);
 
@@ -49,6 +52,9 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour,
                      int header_size, int mode, int method, int offset_x, 
                      int offset_y);
 
+double c_cvContourArea( const CvArr *contour);
+double c_cvContourPerimeter( const void* contour);
+
 void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg);
 
 CvSeq *c_cvHaarDetectObjects( const CvArr* image,
@@ -57,3 +63,8 @@ CvSeq *c_cvHaarDetectObjects( const CvArr* image,
                               int min_neighbors , int flags,
                               int width, int height);
 
+
+void c_cvDrawContours( CvArr * img, CvSeq* contour,
+      CvScalar * external_color,
+      CvScalar * hole_color,
+      int max_level, int max_thickness, int line_type, CvPoint * offset );
diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc
index b6fe55b..88d8e1e 100644
--- a/src/OpenCV/Core/Image.hsc
+++ b/src/OpenCV/Core/Image.hsc
@@ -29,7 +29,8 @@ import Control.Monad (when)
 import Data.Bits (complement, (.&.))
 import Data.Int
 import Data.Proxy
-import Data.Singletons
+import Data.Singletons hiding (Proxy)
+import Data.Singletons.TH
 import Data.Word (Word8, Word16)
 import Foreign.C.Types
 import Foreign.ForeignPtr
diff --git a/src/OpenCV/Drawing.hsc b/src/OpenCV/Drawing.hsc
index 91064a6..708f07b 100644
--- a/src/OpenCV/Drawing.hsc
+++ b/src/OpenCV/Drawing.hsc
@@ -138,4 +138,7 @@ fillConvexPoly (r,g,b) lineType pts =
   where lt = fi $ lineTypeEnum lineType
         flatten (x,y) = [fi x, fi y]
         fi = fromIntegral
-        fr = realToFrac
\ No newline at end of file
+        fr = realToFrac
+
+
+

From 2eeaa3f0f62ede34c28a96943ca991f3ecd02791 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Wed, 7 May 2014 16:22:26 -0400
Subject: [PATCH 137/137] createVideoWriter should not accept Monochrome images

* http://docs.opencv.org/modules/highgui/doc/reading_and_writing_images_and_video.html#videowriter-videowriter
* the error in https://gist.github.com/aavogt/59da0e98bfeaac0c9f1b
  becomes a type error with this change
---
 src/OpenCV/Video.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/OpenCV/Video.hs b/src/OpenCV/Video.hs
index b57a300..de032e7 100644
--- a/src/OpenCV/Video.hs
+++ b/src/OpenCV/Video.hs
@@ -73,7 +73,7 @@ mpeg4CC = ('F','M','P','4')
 -- returned action may be used to add frames to the video stream.
 createVideoWriter :: (HasDepth d, UpdateROI r) =>
                      FilePath -> FourCC -> Double -> (Int,Int) -> 
-                     IO (Image c d r -> IO ())
+                     IO (Image Trichromatic d r -> IO ())
 createVideoWriter fname codec fps sz = 
     do writer <- createVideoWriterF fname codec fps sz
        let writeFrame img = withForeignPtr writer $ \writer' ->