module CV.Transforms where
import CV.Image as I
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Marshal.Array
import System.IO.Unsafe
import CV.Image
import CV.ImageMathOp
import qualified CV.Matrix as M
import CV.Matrix (Matrix,withMatPtr)
takeEvenSized img = getRegion (0,0) (wwadjust,hhadjust) img
where
(w,h) = getSize img
hadjust | odd h = 1
| otherwise = 2
wadjust | odd w = 1
| otherwise = 2
dct :: Image GrayScale d -> Image GrayScale d
dct img | (x,y) <- getSize img, even x && even y
= unsafePerformIO $
withGenImage img $ \i ->
withClone img $ \c' ->
withGenImage c' $ \c ->
(cvDCT i c 0)
| otherwise = error "DCT needs even sized image"
idct :: Image GrayScale d -> Image GrayScale d
idct img | (x,y) <- getSize img, even x && even y
= unsafePerformIO $
withGenImage img $ \i ->
withClone img $ \c' ->
withGenImage c' $ \c ->
(cvDCT i c 1)
| otherwise = error "IDCT needs even sized image"
data MirrorAxis = Vertical | Horizontal deriving (Show,Eq)
flip :: CreateImage (Image c d) => MirrorAxis -> Image c d -> Image c d
flip axis img = unsafePerformIO $ do
cl <- I.create (getSize img)
withGenImage img $ \cimg ->
withGenImage cl $ \ccl -> do
cvFlip cimg ccl (if axis == Vertical then 0 else 1)
return cl
rotate :: Double -> Image c d -> Image c d
rotate (realToFrac -> angle) img = unsafePerformIO $
withImage img $ \i ->
creatingImage
(rotateImage i 1 angle)
data Interpolation = NearestNeighbour | Linear
| Area | Cubic
deriving (Eq,Ord,Enum,Show)
radialDistort :: Image GrayScale D32 -> Double -> Image GrayScale D32
radialDistort img k = unsafePerformIO $ do
target <- I.create (getSize img)
withImage img $ \cimg ->
withImage target $\ctarget ->
radialRemap cimg ctarget (realToFrac k)
return target
scaleSingleRatio tpe x img = scale tpe (x,x) img
scale :: (CreateImage (Image c D32), RealFloat a) => Interpolation -> (a,a) -> Image c D32 -> Image c D32
scale tpe (x,y) img = unsafePerformIO $ do
target <- I.create (w',h')
withGenImage img $ \i ->
withGenImage target $ \t ->
cvResize i t
(fromIntegral.fromEnum $ tpe)
return target
where
(w,h) = getSize img
(w',h') = (round $ fromIntegral w*y
,round $ fromIntegral h*x)
scaleToSize :: (CreateImage (Image c D32)) =>
Interpolation -> Bool -> (Int,Int) -> Image c D32 -> Image c D32
scaleToSize tpe retainRatio (w,h) img = unsafePerformIO $ do
target <- I.create (w',h')
withGenImage img $ \i ->
withGenImage target $ \t ->
cvResize i t
(fromIntegral.fromEnum $ tpe)
return target
where
(ow,oh) = getSize img
(w',h') = if retainRatio
then (floor $ fromIntegral ow*ratio,floor $ fromIntegral oh*ratio)
else (w,h)
ratio = max (fromIntegral w/fromIntegral ow)
(fromIntegral h/fromIntegral oh)
perspectiveTransform :: Real a => Image c d -> [a] -> Image c d
perspectiveTransform img (map realToFrac -> [a1,a2,a3,a4,a5,a6,a7,a8,a9])
= unsafePerformIO $
withImage img $ \cimg -> creatingImage $ wrapPerspective cimg a1 a2 a3 a4 a5 a6 a7 a8 a9
perspectiveTransform' :: (CreateImage (Image c d)) => Matrix Float -> Image c d -> (Int,Int)-> Image c d
perspectiveTransform' mat img size
= unsafePerformIO $ do
r <- create size
withImage img $ \c_img ->
withMatPtr mat $ \c_mat ->
withImage r $ \c_r -> wrapWarpPerspective (castPtr c_img) (castPtr c_r) (castPtr c_mat)
return r
getHomography srcPts dstPts =
unsafePerformIO $ withArray src $\c_src ->
withArray dst $\c_dst ->
allocaArray (3*3) $\c_hmg -> do
findHomography c_src c_dst (fromIntegral $ length srcPts) c_hmg
peekArray (3*3) c_hmg
where
flatten = map realToFrac . concatMap (\(a,b) -> [a,b])
src = flatten srcPts
dst = flatten dstPts
data HomographyMethod = Default
| Ransac
| LMeds
instance Enum HomographyMethod where
fromEnum Default = 0
fromEnum Ransac = 8
fromEnum LMeds = 4
toEnum 0 = Default
toEnum 8 = Ransac
toEnum 4 = LMeds
toEnum unmatched = error ("HomographyMethod.toEnum: Cannot match " ++ show unmatched)
getHomography' :: Matrix Float -> Matrix Float -> HomographyMethod -> Float -> Matrix Float
getHomography' srcPts dstPts method ransacThreshold =
unsafePerformIO $ do
hmg <- M.create (3,3) :: IO (Matrix Float)
withMatPtr srcPts $\c_src ->
withMatPtr dstPts $\c_dst ->
withMatPtr hmg $\c_hmg -> do
cvFindHomography
(castPtr c_src)
(castPtr c_dst)
(castPtr c_hmg)
(fromIntegral $ fromEnum method)
(realToFrac ransacThreshold)
nullPtr
return hmg
evenize :: Image channels depth -> Image channels depth
evenize img = if (odd w || odd h)
then
unsafePerformIO $
creatingImage $
withGenImage img $\cImg -> makeEvenUp cImg
else img
where
(w,h) = getSize img
oddize :: Image channels depth -> Image channels depth
oddize img = if (even w || even h)
then
unsafePerformIO $
creatingImage $
withGenImage img $\cImg -> padUp cImg (toI $even w) (toI $ even h)
else img
where
toI True = 1
toI False = 0
(w,h) = getSize img
sameSizePad :: Image channels depth -> Image c d -> Image channels depth
sameSizePad img img2 = if (size1 /= size2)
then unsafePerformIO $ do
r <- creatingImage $
withGenImage img2 $\cImg -> padUp cImg (toI $w2<w1) (toI $ h2<h1)
if getSize r /= getSize img
then error ("Couldn't pad: "++show size1++"/"++show size2)
else return r
else img
where
toI True = 1
toI False = 0
size1@(w1,h1) = getSize img
size2@(w2,h2) = getSize img2
cv_Gaussian = 7
pyrDown ::(CreateImage (Image GrayScale a)) => Image GrayScale a -> Image GrayScale a
pyrDown image = unsafePerformIO $ do
res <- I.create size
withGenImage image $\cImg ->
withGenImage res $\cResImg ->
cvPyrDown cImg cResImg cv_Gaussian
return res
where
size = (x`div`2,y`div`2)
(x,y) = getSize image
pyrUp :: (CreateImage (Image GrayScale a)) => Image GrayScale a -> Image GrayScale a
pyrUp image = unsafePerformIO $ do
res <- I.create size
withGenImage image $\cImg ->
withGenImage res $\cResImg ->
cvPyrUp cImg cResImg cv_Gaussian
return res
where
size = (x*2,y*2)
(x,y) = getSize image
safePyrDown img = evenize result
where
result = pyrDown img
(w,h) = getSize result
minEnlarge :: Image GrayScale D32 -> Image GrayScale D32
minEnlarge i = enlargeShadow (min (ceiling (logBase 2 (f w))) (ceiling (logBase 2 (f h)))) i
where
f = fromIntegral
(w,h) = getSize i
gaussianPyramid :: Image GrayScale D32 -> [Image GrayScale D32]
gaussianPyramid = iterate pyrDown' . minEnlarge
where
pyrDown' i = let (w,h) = getSize i
in if (w`div`2) <=1 ||(h`div`2) <= 1 then i else pyrDown i
laplacianPyramid :: Int -> Image GrayScale D32 -> [Image GrayScale D32]
laplacianPyramid depth image = reverse laplacian
where
downs :: [Image GrayScale D32] = take depth $ iterate pyrDown (image)
upsampled :: [Image GrayScale D32] = map pyrUp (tail downs)
laplacian = zipWith (#-) downs upsampled ++ [last downs]
reconstructFromLaplacian :: [Image GrayScale D32] -> Image GrayScale D32
reconstructFromLaplacian pyramid = foldl1 (\a b -> (pyrUp a) #+ b) (pyramid)
enlarge :: Int -> Image GrayScale D32 -> Image GrayScale D32
enlarge n img = unsafePerformIO $ do
i <- I.create (w2,h2)
blit i img (0,0)
return i
where
(w,h) = getSize img
(w2,h2) = (pad w, pad h)
pad x = x + (np x `mod` np)
np = 2^n
enlargeShadow :: Int -> Image GrayScale D32 -> Image GrayScale D32
enlargeShadow n img = unsafePerformIO $ do
i <- create (w2,h2)
withImage img $\c_img ->
withImage i $ \c_i -> blitShadow c_i c_img
return i
where
(w,h) = getSize img
(w2,h2) = (pad w, pad h)
pad x = x + (np x `mod` np)
np = 2^n
data DistanceType = C
| L1
| L2
instance Enum DistanceType where
fromEnum C = 3
fromEnum L1 = 1
fromEnum L2 = 2
toEnum 3 = C
toEnum 1 = L1
toEnum 2 = L2
toEnum unmatched = error ("DistanceType.toEnum: Cannot match " ++ show unmatched)
data MaskSize = M3 |M5 deriving (Eq,Ord,Enum,Show)
distanceTransform :: DistanceType -> MaskSize -> Image GrayScale D8 -> Image GrayScale D32
distanceTransform dtype maskSize source = unsafePerformIO $ do
result :: Image GrayScale D32 <- I.create (getSize source)
withGenImage source $ \c_source ->
withGenImage result $ \c_result ->
cvDistTransform c_source c_result
(fromIntegral . fromEnum $ dtype)
(fromIntegral . fromEnum $ maskSize)
nullPtr nullPtr
return result
foreign import ccall safe "CV/Transforms.chs.h cvDCT"
cvDCT :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h cvFlip"
cvFlip :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h rotateImage"
rotateImage :: ((Ptr (BareImage)) -> (CDouble -> (CDouble -> (IO (Ptr (BareImage))))))
foreign import ccall safe "CV/Transforms.chs.h radialRemap"
radialRemap :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (CDouble -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h cvResize"
cvResize :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h wrapPerspective"
wrapPerspective :: ((Ptr (BareImage)) -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO (Ptr (BareImage)))))))))))))
foreign import ccall safe "CV/Transforms.chs.h wrapWarpPerspective"
wrapWarpPerspective :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h findHomography"
findHomography :: ((Ptr CDouble) -> ((Ptr CDouble) -> (CInt -> ((Ptr CDouble) -> (IO ())))))
foreign import ccall safe "CV/Transforms.chs.h cvFindHomography"
cvFindHomography :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (CInt -> (CDouble -> ((Ptr ()) -> (IO CInt)))))))
foreign import ccall safe "CV/Transforms.chs.h makeEvenUp"
makeEvenUp :: ((Ptr (BareImage)) -> (IO (Ptr (BareImage))))
foreign import ccall safe "CV/Transforms.chs.h padUp"
padUp :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (IO (Ptr (BareImage))))))
foreign import ccall safe "CV/Transforms.chs.h cvPyrDown"
cvPyrDown :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h cvPyrUp"
cvPyrUp :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Transforms.chs.h blitShadow"
blitShadow :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ())))
foreign import ccall safe "CV/Transforms.chs.h cvDistTransform"
cvDistTransform :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (CInt -> ((Ptr CFloat) -> ((Ptr ()) -> (IO ())))))))