module System.Win32.Com.HDirect.WideString where
import System.Win32.Com.HDirect.PointerPrim ( primAllocMemory )
import System.Win32.Com.HDirect.Pointer ( stackFrame, freeMemory )
import Foreign.Ptr ( castPtr, nullPtr, plusPtr )
import System.Win32.Com.HDirect.HDirect
import System.IO.Unsafe ( unsafePerformIO )
type LPWSTR = WideString
type LPCWSTR = WideString
newtype WideString = WideString (Ptr Wchar_t)
lengthWideString :: WideString -> Int
lengthWideString (WideString ws) = unsafePerformIO (lenWideString ws >>= return . fromIntegral)
stackWideString :: String -> (Ptr Wchar_t -> IO a) -> IO a
stackWideString str wcont = do
stackString str $ \ len pstr -> do
let wlen = wideStringLen pstr
stackFrame (sizeofWideString*(wlen+1)) $ \ pwide -> do
primStringToWide pstr (fromIntegral len) pwide wlen
wcont pwide
mkWideString :: String -> WideString
mkWideString ls = unsafePerformIO (stringToWide ls)
stringToWide :: String -> IO WideString
stringToWide str =
stackString str $ \ len pstr -> do
let wlen = wideStringLen pstr
pwide <- primAllocMemory ((wlen + 1) * sizeofWideString)
primStringToWide pstr (fromIntegral len) (castPtr pwide) wlen
unmarshallWideString (castPtr pwide)
word16ToWideString :: Word16 -> IO WideString
word16ToWideString w =
return (WideString (plusPtr nullPtr (fromIntegral w)))
nullWideString :: WideString
nullWideString = WideString (nullPtr)
stackString :: String -> (Int -> Ptr Char -> IO a) -> IO a
stackString str pcont = do
let len = 1 + fromIntegral (length str)
stackFrame len $ \ ptr -> do
writeString False ptr str
pcont (fromIntegral len) (castPtr ptr)
marshallWideString :: WideString -> IO (Ptr WideString)
marshallWideString (WideString ptr) = marshallPointer ptr >>= return.castPtr
marshallWideString2 :: String -> IO (Ptr WideString)
marshallWideString2 str = do
wstr <- stringToWide str
marshallWideString wstr
unmarshallWideString :: Ptr a -> IO WideString
unmarshallWideString ptr = do
po <- unmarshallPointer ptr
return (WideString (castPtr po))
unmarshallWideString2 :: Ptr a -> IO String
unmarshallWideString2 ptr = do
po <- unmarshallPointer ptr
wideToStr (WideString (castPtr po))
writeWideString :: Ptr WideString -> WideString -> IO ()
writeWideString ptr (WideString pstr) = writePointer (castPtr ptr) pstr
writeWideString2 :: Ptr WideString -> String -> IO ()
writeWideString2 ptr str = do
pwstr <- marshallWideString2 str
writePointer (castPtr ptr) pwstr
readWideString :: Ptr WideString -> IO WideString
readWideString p = unmarshallWideString (castPtr p)
readWideString2 :: Ptr WideString -> IO String
readWideString2 p = unmarshallWideString2 (castPtr p)
freeWideString :: Ptr WideString -> IO ()
freeWideString _ = return ()
freeWString :: WideString -> IO ()
freeWString (WideString pstr) = freeMemory pstr
sizeofWideString :: Word32
sizeofWideString = 2
wideToStr :: WideString -> IO String
wideToStr wide = do
pwide <- marshallWideString wide
(pstr,_) <- wideToString (castPtr pwide)
unmarshallString (castPtr pstr)
wideStringLen :: Ptr Char
-> Word32
wideStringLen str =
unsafePerformIO (prim_System_Win32_Com_HDirect_WideString_wideStringLen str)
foreign import ccall "wideStringLen" prim_System_Win32_Com_HDirect_WideString_wideStringLen :: Ptr Char -> IO Word32
wideToString :: Ptr Wchar_t
-> IO (Ptr Char, Int32)
wideToString wstr =
do
pstr <- allocBytes (fromIntegral sizeofPtr)
o_wideToString <- prim_System_Win32_Com_HDirect_WideString_wideToString wstr pstr
pstr <- doThenFree free readPtr pstr
return (pstr, o_wideToString)
foreign import ccall "wideToString" prim_System_Win32_Com_HDirect_WideString_wideToString :: Ptr Word16 -> Ptr (Ptr Char) -> IO Int32
lenWideString :: Ptr Wchar_t
-> IO Int32
lenWideString wstr =
prim_System_Win32_Com_HDirect_WideString_lenWideString wstr
foreign import ccall "lenWideString" prim_System_Win32_Com_HDirect_WideString_lenWideString :: Ptr Word16 -> IO Int32
primStringToWide :: Ptr Char
-> Word32
-> Ptr Wchar_t
-> Word32
-> IO Int32
primStringToWide str len wstr wlen =
prim_System_Win32_Com_HDirect_WideString_primStringToWide str
len
wstr
wlen
foreign import ccall "primStringToWide" prim_System_Win32_Com_HDirect_WideString_primStringToWide :: Ptr Char -> Word32 -> Ptr Word16 -> Word32 -> IO Int32