module OpenCV.Extra.XPhoto.WhiteBalancer
( WhiteBalancer (..)
, GrayworldWB
, LearningBasedWB
, SimpleWB
, newGrayworldWB
, newLearningBasedWB
, newSimpleWB
) where
import "base" Data.Int
import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
import "base" Foreign.Marshal.Alloc ( alloca )
import "base" Foreign.Marshal.Utils ( toBool )
import "base" Foreign.Storable ( peek )
import qualified "inline-c" Language.C.Inline as C
import qualified "inline-c" Language.C.Inline.Unsafe as CU
import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
import "opencv" OpenCV.Core.Types
import "opencv" OpenCV.Internal
import "opencv" OpenCV.Internal.Core.Types.Mat
import "opencv" OpenCV.Internal.C.Types
import "primitive" Control.Monad.Primitive
import "this" OpenCV.Extra.Internal.C.Inline ( openCvExtraCtx )
import "this" OpenCV.Extra.Internal.C.Types
import "opencv" OpenCV.TypeLevel
C.context openCvExtraCtx
C.include "opencv2/core.hpp"
C.include "opencv2/xphoto.hpp"
C.include "white-ballance.hpp"
C.using "namespace cv"
class WhiteBalancer a where
balanceWhite
:: (PrimMonad m)
=> a (PrimState m)
-> Mat ('S [h, w]) channels depth
-> m (Mat ('S [h, w]) channels depth)
newtype GrayworldWB s
= GrayworldWB
{ unGrayworldWB :: ForeignPtr C'Ptr_GrayworldWB }
type instance C (GrayworldWB s) = C'Ptr_GrayworldWB
instance WithPtr (GrayworldWB s) where
withPtr = withForeignPtr . unGrayworldWB
instance FromPtr (GrayworldWB s) where
fromPtr = objFromPtr GrayworldWB $ \ptr ->
[CU.block| void {
cv::Ptr<cv::xphoto::GrayworldWB> * knn_ptr_ptr =
$(Ptr_GrayworldWB * ptr);
knn_ptr_ptr->release();
delete knn_ptr_ptr;
}|]
newtype LearningBasedWB s
= LearningBasedWB
{ unLearningBasedWB :: ForeignPtr C'Ptr_LearningBasedWB }
type instance C (LearningBasedWB s) = C'Ptr_LearningBasedWB
instance WithPtr (LearningBasedWB s) where
withPtr = withForeignPtr . unLearningBasedWB
instance FromPtr (LearningBasedWB s) where
fromPtr = objFromPtr LearningBasedWB $ \ptr ->
[CU.block| void {
cv::Ptr<cv::xphoto::LearningBasedWB> * knn_ptr_ptr =
$(Ptr_LearningBasedWB * ptr);
knn_ptr_ptr->release();
delete knn_ptr_ptr;
}|]
newtype SimpleWB s
= SimpleWB
{ unSimpleWB :: ForeignPtr C'Ptr_SimpleWB }
type instance C (SimpleWB s) = C'Ptr_SimpleWB
instance WithPtr (SimpleWB s) where
withPtr = withForeignPtr . unSimpleWB
instance FromPtr (SimpleWB s) where
fromPtr = objFromPtr SimpleWB $ \ptr ->
[CU.block| void {
cv::Ptr<cv::xphoto::SimpleWB> * knn_ptr_ptr =
$(Ptr_SimpleWB * ptr);
knn_ptr_ptr->release();
delete knn_ptr_ptr;
}|]
instance Algorithm GrayworldWB where
algorithmClearState knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
[C.block|void {
cv::xphoto::GrayworldWB * knn = *$(Ptr_GrayworldWB * knnPtr);
knn->clear();
}|]
algorithmIsEmpty knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
alloca $ \emptyPtr -> do
[C.block|void {
cv::xphoto::GrayworldWB * knn = *$(Ptr_GrayworldWB * knnPtr);
*$(bool * emptyPtr) = knn->empty();
}|]
toBool <$> peek emptyPtr
instance Algorithm LearningBasedWB where
algorithmClearState knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
[C.block|void {
cv::xphoto::LearningBasedWB * knn = *$(Ptr_LearningBasedWB * knnPtr);
knn->clear();
}|]
algorithmIsEmpty knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
alloca $ \emptyPtr -> do
[C.block|void {
cv::xphoto::LearningBasedWB * knn = *$(Ptr_LearningBasedWB * knnPtr);
*$(bool * emptyPtr) = knn->empty();
}|]
toBool <$> peek emptyPtr
instance Algorithm SimpleWB where
algorithmClearState knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
[C.block|void {
cv::xphoto::SimpleWB * knn = *$(Ptr_SimpleWB * knnPtr);
knn->clear();
}|]
algorithmIsEmpty knn = unsafePrimToPrim $
withPtr knn $ \knnPtr ->
alloca $ \emptyPtr -> do
[C.block|void {
cv::xphoto::SimpleWB * knn = *$(Ptr_SimpleWB * knnPtr);
*$(bool * emptyPtr) = knn->empty();
}|]
toBool <$> peek emptyPtr
instance WhiteBalancer GrayworldWB where
balanceWhite wbAlg imgIn = unsafePrimToPrim $ do
imgOut <- newEmptyMat
withPtr wbAlg $ \wbAlgPtr ->
withPtr imgIn $ \imgInPtr ->
withPtr imgOut $ \imgOutPtr -> do
[C.block| void {
cv::xphoto::GrayworldWB * wb = *$(Ptr_GrayworldWB * wbAlgPtr);
wb->balanceWhite
( *$(Mat * imgInPtr)
, *$(Mat * imgOutPtr)
);
}|]
pure $ unsafeCoerceMat imgOut
instance WhiteBalancer LearningBasedWB where
balanceWhite wbAlg imgIn = unsafePrimToPrim $ do
imgOut <- newEmptyMat
withPtr wbAlg $ \wbAlgPtr ->
withPtr imgIn $ \imgInPtr ->
withPtr imgOut $ \imgOutPtr -> do
[C.block| void {
cv::xphoto::LearningBasedWB * wb = *$(Ptr_LearningBasedWB * wbAlgPtr);
wb->balanceWhite
( *$(Mat * imgInPtr)
, *$(Mat * imgOutPtr)
);
}|]
pure $ unsafeCoerceMat imgOut
instance WhiteBalancer SimpleWB where
balanceWhite wbAlg imgIn = unsafePrimToPrim $ do
imgOut <- newEmptyMat
withPtr wbAlg $ \wbAlgPtr ->
withPtr imgIn $ \imgInPtr ->
withPtr imgOut $ \imgOutPtr -> do
[C.block| void {
cv::xphoto::SimpleWB * wb = *$(Ptr_SimpleWB * wbAlgPtr);
wb->balanceWhite
( *$(Mat * imgInPtr)
, *$(Mat * imgOutPtr)
);
}|]
pure $ unsafeCoerceMat imgOut
newGrayworldWB
:: (PrimMonad m)
=> Maybe Double
-> m (GrayworldWB (PrimState m))
newGrayworldWB mbVarThreshold = unsafePrimToPrim $ fromPtr
[CU.block|Ptr_GrayworldWB * {
cv::Ptr<cv::xphoto::GrayworldWB> wbAlg = cv::xphoto::createGrayworldWB ();
wbAlg->setSaturationThreshold($(double c'varThreshold ));
return new cv::Ptr<cv::xphoto::GrayworldWB>(wbAlg);
}|]
where
c'varThreshold = maybe 0.9 realToFrac mbVarThreshold
newLearningBasedWB
:: (PrimMonad m)
=> Maybe Int32
-> Maybe Int32
-> Maybe Double
-> m (LearningBasedWB (PrimState m))
newLearningBasedWB mbVarHistBinNum mbRangeMaxVal mbVarSaturationThreshold
= unsafePrimToPrim $ fromPtr
[CU.block|Ptr_LearningBasedWB * {
cv::Ptr<cv::xphoto::LearningBasedWB> wbAlg = cv::xphoto::createLearningBasedWB ();
wbAlg->setHistBinNum($(int c'varHistBinNum ));
wbAlg->setRangeMaxVal($(int c'varRangeMaxVal ));
wbAlg->setSaturationThreshold($(double c'varSaturationThreshold ));
return new cv::Ptr<cv::xphoto::LearningBasedWB>(wbAlg);
}|]
where
c'varHistBinNum = maybe 64 fromIntegral mbVarHistBinNum
c'varRangeMaxVal = maybe 255 fromIntegral mbRangeMaxVal
c'varSaturationThreshold = maybe 0.98 realToFrac mbVarSaturationThreshold
newSimpleWB
:: (PrimMonad m)
=> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> m (SimpleWB (PrimState m))
newSimpleWB mbIMin mbIMax mbOMin mbOMax mbP = unsafePrimToPrim $ fromPtr
[CU.block|Ptr_SimpleWB * {
cv::Ptr<cv::xphoto::SimpleWB> wbAlg = cv::xphoto::createSimpleWB ();
wbAlg->setInputMin( $(double c'varIMin ));
wbAlg->setInputMax( $(double c'varIMax ));
wbAlg->setOutputMin($(double c'varOMin ));
wbAlg->setOutputMax($(double c'varOMax ));
wbAlg->setP($(double c'varP ));
return new cv::Ptr<cv::xphoto::SimpleWB>(wbAlg);
}|]
where
c'varIMin = maybe 0 realToFrac mbIMin
c'varIMax = maybe 255 realToFrac mbIMax
c'varOMin = maybe 0 realToFrac mbOMin
c'varOMax = maybe 255 realToFrac mbOMax
c'varP = maybe 2 realToFrac mbP