Skip to content

Commit

Permalink
Merge related changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@aleator
aleator committed Aug 17, 2012
2 parents 25c49c9 + dabe89c commit 43c475b
Show file tree
Hide file tree
Showing 5 changed files with 107 additions and 70 deletions.
125 changes: 74 additions & 51 deletions CV/Drawing.chs
View file
@@ -1,4 +1,4 @@
{-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances,
{-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances,
ViewPatterns, FlexibleContexts #-}
#include "cvWrapLEO.h"
-- | Module for exposing opencv drawing functions. These are meant for quick and dirty marking
Expand Down Expand Up @@ -54,10 +54,10 @@ styleToCV Filled = -1
styleToCV (Stroked w) = fromIntegral w

-- TODO: The instances in here could be significantly smaller..
-- |Typeclass for images that support elementary drawing operations.
-- |Typeclass for images that support elementary drawing operations.
class Drawable a b where
-- | Type of the pixel, i.e. Float for a grayscale image and 3-tuple for RGB image.
type Color a b :: *
type Color a b :: *
-- | Put text of certain color to given coordinates. Good size seems to be around 0.5-1.5.
putTextOp :: (Color a b) -> Float -> String -> (Int,Int) -> ImageOperation a b
-- | Draw a line between two points.
Expand All @@ -68,77 +68,98 @@ class Drawable a b where
rectOp :: (BoundingBox bb, Integral (ELBB bb)) => (Color a b) -> Int -> bb -> ImageOperation a b
-- | Draw a filled polygon
fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b
-- | Draw an ellipse or elliptic arc
ellipseOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> Float -> (Float,Float) -> ImageOperation a b
ellipseBoxOp :: (Color a b) -> C'CvBox2D -> Int -> Int -> ImageOperation a b

primRectOp (r,g,b) t (bounds -> Rectangle x y w h) = ImgOp $ \i -> do
withGenImage i $ \img ->
withGenImage i $ \img ->
{#call wrapDrawRectangle#} img (fromIntegral x)
(fromIntegral y) (fromIntegral $ x+w) (fromIntegral $ y+h)
(realToFrac r) (realToFrac g)(realToFrac b)(fromIntegral t)

-- | Primitive form of ellipse box. Not typesafe, not for end user.
primEllipseBox :: (D32,D32,D32,D32) -> C'CvBox2D -> Int -> Int -> ImageOperation c d

primEllipseBox (a,b,c,e) box thickness shift =
ImgOp $ \i ->
withGenImage i $ \c_img ->
primEllipseBox (a,b,c,e) box thickness shift =
ImgOp $ \i ->
withGenImage i $ \c_img ->
with box $ \c_box ->
with (C'CvScalar (rtf a) (rtf b) (rtf c) (rtf 0)) $ \c_color ->
c'wrapEllipseBox c_img c_box c_color (fromIntegral thickness) 8
with (C'CvScalar (rtf a) (rtf b) (rtf c) (rtf 0)) $ \c_color ->
c'wrapEllipseBox c_img c_box c_color (fromIntegral thickness) 8
(fromIntegral shift)

rtf = realToFrac

instance Drawable RGB D32 where
type Color RGB D32 = (D32,D32,D32)
putTextOp (r,g,b) = primTextOp (r,g,b)
lineOp (r,g,b) = primLineOp (r,g,b)
putTextOp (r,g,b) = primTextOp (r,g,b)
lineOp (r,g,b) = primLineOp (r,g,b)
circleOp (r,g,b) = primCircleOp (r,g,b)
ellipseBoxOp (r,g,b) = primEllipseBox (r,g,b,0)
ellipseBoxOp (r,g,b) = primEllipseBox (r,g,b,0)
rectOp (r,g,b) = primRectOp (r,g,b)
fillPolyOp (r,g,b) = primFillPolyOp (r,g,b)
fillPolyOp (r,g,b) = primFillPolyOp (r,g,b)
ellipseOp (r,g,b) = primEllipseOp (r,g,b)

primTextOp (c1,c2,c3) size text (x,y) = ImgOp $ \img -> do
withGenImage img $ \cimg ->
withCString text $ \(ctext) ->
{#call wrapDrawText#} cimg ctext (realToFrac size)
(fromIntegral x) (fromIntegral y)
(realToFrac c1) (realToFrac c2) (realToFrac c3)
{#call wrapDrawText#} cimg ctext (realToFrac size)
(fromIntegral x) (fromIntegral y)
(realToFrac c1) (realToFrac c2) (realToFrac c3)

primLineOp (c1,c2,c3) t (x,y) (x1,y1) = ImgOp $ \i -> do
withGenImage i $ \img ->
{#call wrapDrawLine#} img (fromIntegral x) (fromIntegral y)
(fromIntegral x1) (fromIntegral y1)
(realToFrac c1) (realToFrac c2)
(realToFrac c3) (fromIntegral t)
withGenImage i $ \img ->
{#call wrapDrawLine#} img (fromIntegral x) (fromIntegral y)
(fromIntegral x1) (fromIntegral y1)
(realToFrac c1) (realToFrac c2)
(realToFrac c3) (fromIntegral t)

primCircleOp (c1,c2,c3) (x,y) r s = ImgOp $ \i -> do
when (r>0) $ withGenImage i $ \img ->
({#call wrapDrawCircle#} img (fromIntegral x) (fromIntegral y)
(fromIntegral r)
(realToFrac c1) (realToFrac c2)
(realToFrac c3)
when (r>0) $ withGenImage i $ \img ->
({#call wrapDrawCircle#} img (fromIntegral x) (fromIntegral y)
(fromIntegral r)
(realToFrac c1) (realToFrac c2)
(realToFrac c3)
$ styleToCV s)

primFillPolyOp (c1,c2,c3) pts = ImgOp $ \i -> do
withImage i $ \img -> do
let (xs,ys) = unzip pts
xs' <- newArray $ map fromIntegral xs
ys' <- newArray $ map fromIntegral ys
{#call wrapFillPolygon#} (castPtr img)
(fromIntegral $ length xs) xs' ys'
(realToFrac c1) (realToFrac c2) (realToFrac c3)
{#call wrapFillPolygon#} (castPtr img)
(fromIntegral $ length xs) xs' ys'
(realToFrac c1) (realToFrac c2) (realToFrac c3)
free xs'
free ys'

primEllipseOp (c1,c2,c3) t (x,y) (r1,r2) a (a1,a2) =
ImgOp $ \i -> do
withGenImage i $ \img ->
{#call wrapDrawEllipse#} img
(fromIntegral x)
(fromIntegral y)
(fromIntegral r1)
(fromIntegral r2)
(realToFrac a)
(realToFrac a1)
(realToFrac a2)
(realToFrac c1)
(realToFrac c2)
(realToFrac c3)
(fromIntegral t)


instance Drawable CV.Image.Complex D32 where
type Color CV.Image.Complex D32 = Complex D32
putTextOp (r:+i) = primTextOp (r,i,0) -- Boy does this feel silly :)
lineOp (r:+i) = primLineOp (r,i,0)
circleOp (r:+i) = primCircleOp (r,i,0)
rectOp (r:+i) = primRectOp (r,i,0)
ellipseBoxOp (r:+i) = primEllipseBox (r,i,0,0)
type Color CV.Image.Complex D32 = Complex D32
putTextOp (r:+i) = primTextOp (r,i,0) -- Boy does this feel silly :)
lineOp (r:+i) = primLineOp (r,i,0)
circleOp (r:+i) = primCircleOp (r,i,0)
rectOp (r:+i) = primRectOp (r,i,0)
ellipseBoxOp (r:+i) = primEllipseBox (r,i,0,0)
fillPolyOp (r:+i) = primFillPolyOp (r,i,0)
ellipseOp (r:+i) = primEllipseOp (r,i,0)

instance Drawable GrayScale D8 where
type Color GrayScale D8 = D8
Expand All @@ -148,32 +169,34 @@ instance Drawable GrayScale D8 where
ellipseBoxOp c = primEllipseBox (fromIntegral c,fromIntegral c,fromIntegral c,0)
rectOp c = primRectOp (c,c,c)
fillPolyOp c = primFillPolyOp (c,c,c)
ellipseOp c = primEllipseOp (c,c,c)

instance Drawable GrayScale D32 where
type Color GrayScale D32 = D32
putTextOp color = primTextOp (color,color,color)
lineOp c = primLineOp (c,c,c)
putTextOp color = primTextOp (color,color,color)
lineOp c = primLineOp (c,c,c)
circleOp c = primCircleOp (c,c,c)
ellipseBoxOp c = primEllipseBox (c,c,c,0)
ellipseBoxOp c = primEllipseBox (c,c,c,0)
rectOp c = primRectOp (c,c,c)
fillPolyOp c = primFillPolyOp (c,c,c)
ellipseOp c = primEllipseOp (c,c,c)

-- | Flood fill a region of the image
fillOp :: (Int,Int) -> D32 -> D32 -> D32 -> Bool -> ImageOperation GrayScale D32
fillOp (x,y) color low high floats =
fillOp (x,y) color low high floats =
ImgOp $ \i -> do
withImage i $ \img ->
withImage i $ \img ->
({#call wrapFloodFill#} (castPtr img) (fromIntegral x) (fromIntegral y)
(realToFrac color) (realToFrac low) (realToFrac high) (toCINT $ floats))
where
toCINT False = 0
toCINT True = 1

-- | Apply rectOp to an image
rectangle :: (BoundingBox bb, Integral (ELBB bb), Drawable c d)
rectangle :: (BoundingBox bb, Integral (ELBB bb), Drawable c d)
=> Color c d -> Int -> bb -> Image c d
-> IO (Image c d)
rectangle color thickness rect i =
rectangle color thickness rect i =
operate (rectOp color thickness rect) i

-- | Apply fillPolyOp to an image
Expand All @@ -182,8 +205,8 @@ fillPoly c pts i = operate (fillPolyOp c pts) i

-- | Draw a line segments
drawLinesOp :: Drawable c d => Color c d -> Int -> [((Int, Int), (Int, Int))] -> CV.ImageOp.ImageOperation c d
drawLinesOp color thickness segments =
foldl (#>) nonOp
drawLinesOp color thickness segments =
foldl (#>) nonOp
$ map (\(a,b) -> lineOp color thickness a b) segments

-- | Draw a polyline
Expand All @@ -201,13 +224,13 @@ drawLines img color thickness segments = operateOn img
-- | Draw C'CvBox2D
drawBox2Dop :: Drawable c d => Color c d -> C'CvBox2D -> ImageOperation c d
drawBox2Dop color (C'CvBox2D (C'CvPoint2D32f (realToFrac -> x) (realToFrac ->y))
(C'CvSize2D32f (realToFrac -> w) (realToFrac ->h))
(degToRad -> θ))
= drawLinesOp color 1 (zip corners $ tail (cycle corners))
(C'CvSize2D32f (realToFrac -> w) (realToFrac ->h))
(degToRad -> θ))
= drawLinesOp color 1 (zip corners $ tail (cycle corners))
where
rot (x,y) = (x * sin (-θ) - y * cos (-θ)
,x * cos (-θ) + y * sin (-θ))
corners = map (both round . (+ (x,y)) . rot)
corners = map (both round . (+ (x,y)) . rot)
[( 0.5*h, 0.5*w)
,(-0.5*h, 0.5*w)
,(-0.5*h, -0.5*w)
Expand All @@ -223,8 +246,8 @@ circle center r color s i = unsafeOperate (circleOp color center r s) i

-- | Apply fillOp to an image
floodfill :: (Int, Int) -> D32 -> D32 -> D32 -> Bool -> Image GrayScale D32 -> Image GrayScale D32
floodfill (x,y) color low high floats =
unsafeOperate (fillOp (x,y) color low high floats)
floodfill (x,y) color low high floats =
unsafeOperate (fillOp (x,y) color low high floats)




37 changes: 19 additions & 18 deletions CV/Image.chs
View file
Expand Up @@ -72,9 +72,9 @@ module CV.Image (
, tileImages

-- * Conversions
, rgbToGray
, rgbToGray
, grayToRGB
, rgbToLab
, rgbToLab
, bgrToRgb
, rgbToBgr
, cloneTo64F
Expand Down Expand Up @@ -114,6 +114,7 @@ import Foreign.Concurrent
import Foreign.Ptr
import Control.Parallel.Strategies
import Control.DeepSeq

import CV.Bindings.Error

import Data.Maybe(catMaybes)
Expand Down Expand Up @@ -431,37 +432,37 @@ enum CvtCodes {
CV_BayerGB2BGR_VNG =63,
CV_BayerRG2BGR_VNG =64,
CV_BayerGR2BGR_VNG =65,

CV_BayerBG2RGB_VNG =CV_BayerRG2BGR_VNG,
CV_BayerGB2RGB_VNG =CV_BayerGR2BGR_VNG,
CV_BayerRG2RGB_VNG =CV_BayerBG2BGR_VNG,
CV_BayerGR2RGB_VNG =CV_BayerGB2BGR_VNG,

CV_BGR2HSV_FULL = 66,
CV_RGB2HSV_FULL = 67,
CV_BGR2HLS_FULL = 68,
CV_RGB2HLS_FULL = 69,

CV_HSV2BGR_FULL = 70,
CV_HSV2RGB_FULL = 71,
CV_HLS2BGR_FULL = 72,
CV_HLS2RGB_FULL = 73,

CV_LBGR2Lab = 74,
CV_LRGB2Lab = 75,
CV_LBGR2Luv = 76,
CV_LRGB2Luv = 77,

CV_Lab2LBGR = 78,
CV_Lab2LRGB = 79,
CV_Luv2LBGR = 80,
CV_Luv2LRGB = 81,

CV_BGR2YUV = 82,
CV_RGB2YUV = 83,
CV_YUV2BGR = 84,
CV_YUV2RGB = 85,

CV_COLORCVT_MAX =100
};
#endc
Expand Down Expand Up @@ -678,10 +679,10 @@ emptyCopy' img = create (getSize img)

-- | Save image. This will convert the image to 8 bit one before saving
class Save a where
save :: FilePath -> a -> IO ()
save :: FilePath -> a -> IO ()

instance Save (Image BGR D32) where
save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image)
save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image)

instance Save (Image RGB D32) where
save filename image = primitiveSave filename (swapRB . unS . unsafeImageTo8Bit $ image)
Expand All @@ -693,10 +694,10 @@ instance Save (Image GrayScale D8) where
save filename image = primitiveSave filename (unS $ image)

instance Save (Image GrayScale D32) where
save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image)
save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image)

primitiveSave :: FilePath -> BareImage -> IO ()
primitiveSave filename fpi = do
primitiveSave filename fpi = do
exists <- doesDirectoryExist (takeDirectory filename)
when (not exists) $ throw (CvIOError $ "Directory does not exist: " ++ (takeDirectory filename))
withCString filename $ \name ->
Expand Down Expand Up @@ -941,7 +942,7 @@ instance SetPixel (Image RGB D32) where
let cs = fromIntegral s
fs = sizeOf (undefined :: Float)
poke (castPtr (d`plusPtr` (y*cs +x*3*fs))) b
poke (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs))) g
poke (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs))) g
poke (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs))) r

instance SetPixel (Image Complex D32) where
Expand Down Expand Up @@ -974,13 +975,13 @@ getAllPixelsRowMajor image = [getPixel (i,j) image
-- between images. Images are assumed to be the same size (determined by the first image)
montage :: (CreateImage (Image GrayScale D32)) => (Int,Int) -> Int -> [Image GrayScale D32] -> Image GrayScale D32
montage (u',v') space' imgs
| u'*v' /= (length imgs) = error ("Montage mismatch: "++show (u,v, length imgs))
| u'*v' < (length imgs) = error ("Montage mismatch: "++show (u,v, length imgs))
| otherwise = resultPic
where
space = fromIntegral space'
(u,v) = (fromIntegral u', fromIntegral v')
(rw,rh) = (u*xstep,v*ystep)
(w,h) = getSize (head imgs)
(w,h) = foldl (\(mx,my) (x,y) -> (max mx x, max my y)) (0,0) $ map getSize imgs
(xstep,ystep) = (fromIntegral space + w,fromIntegral space + h)
edge = space`div`2
resultPic = unsafePerformIO $ do
Expand All @@ -1005,7 +1006,7 @@ setCatch = do
func <- peekCString cstr1
msg <- peekCString cstr2
file <- peekCString cstr3
throw (CvException (fromIntegral i) func msg file (fromIntegral j))
throw (CvException (fromIntegral i) func msg file (fromIntegral j))
return 0
cb <- mk'CvErrorCallback catch
c'cvRedirectError cb nullPtr nullPtr
Expand Down
8 changes: 8 additions & 0 deletions CV/Operations.hs
View file
Expand Up @@ -2,6 +2,7 @@
module CV.Operations
( clear
, set
, expand
, NormType(..)
, normalize
, unitNormalize
Expand All @@ -11,6 +12,7 @@ module CV.Operations
) where

import CV.Bindings.Core
import CV.Bindings.ImgProc
import CV.Bindings.Types
import CV.Image
import CV.ImageMath as IM
Expand All @@ -31,6 +33,12 @@ set v i = unsafePerformIO $ do
c'wrapSetAll (castPtr i_ptr) (realToFrac v) nullPtr
return i


expand :: (Int,Int,Int,Int) -> Image d c -> Image d c
expand (top,bottom,left,right) i = unsafePerformIO $
copyMakeBorder i top bottom left right BorderReplicate 0


data NormType =
NormC |
NormL1 |
Expand Down
5 changes: 4 additions & 1 deletion cbits/cvWrapLEO.c
View file
Expand Up @@ -404,7 +404,10 @@ void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, float r, float g,
free(pts);
}


void wrapDrawEllipse(IplImage *img, int x, int y, int r1, int r2, float a, float a1, float a2, float r, float g, float b, int thickness)
{
cvEllipse(img, cvPoint(x,y),cvSize(r1,r2),a,a1,a2,CV_RGB(r,g,b),thickness,8,0);
}

int getImageWidth(IplImage *img)
{
Expand Down

0 comments on commit 43c475b

Please sign in to comment.