module System.Win32.Com.HDirect.Pointer
(
Ptr
, allocMemory
, stackFrame
, writeSeqAtDec
, freeMemory
, freeBSTR
, freeWith
, freeWithC
, primNoFree
, finalNoFree
, finalFreeMemory
, makeFO
) where
import Foreign.Ptr
import Foreign.ForeignPtr
import System.Win32.Com.HDirect.PointerPrim
import Data.Word ( Word32 )
import Control.Exception
import Control.Monad
type Finalizer a = Ptr a -> IO ()
makeFO :: Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr b)
makeFO obj finaliser = newForeignPtr (mkFinal finaliser obj) obj >>= return.castForeignPtr
mkFinal final _ = final
--Helpers.
writeSeqAtDec :: Word32 -> [Ptr a -> IO ()] -> Ptr a -> IO ()
writeSeqAtDec size ws ptr = go init_ptr ws
where
len = fromIntegral (length ws 1)
init_ptr = ptr `plusPtr` (size_i * len)
size_i = fromIntegral size
go _ [] = return ()
go ptr (x:xs) = do
x ptr
let ptr_next = ptr `plusPtr` (size_i)
go ptr_next xs
stackFrame :: Word32 -> (Ptr a -> IO b) -> IO b
stackFrame size f
= do p <- allocMemory size
f p `always` primFreeMemory (castPtr p)
freeMemory = freeWithC primFreeMemory
freeBSTR = freeWithC primFreeBSTR
freeWithC :: Finalizer () -> Ptr a -> IO ()
freeWithC final p = final (castPtr p)
freeWith :: (Ptr a -> IO ()) -> Ptr a -> IO ()
freeWith free p = free p
always :: IO a -> IO () -> IO a
always io action
= io `finally` action
--Primitives/helpers:
allocMemory :: Word32 -> IO (Ptr a)
allocMemory sz = do
a <- primAllocMemory sz
if a == nullPtr then
ioError (userError "allocMemory: not enough memory")
else
return (castPtr a)