hdirect-0.21.0: comlib/WideString.hs

{-# OPTIONS -#include <stdlib.h> #-}
{-# OPTIONS -#include "WideStringSrc.h" #-}
{-# OPTIONS -#include "PointerSrc.h" #-}
-- Automatically generated by HaskellDirect (ihc.exe), version 0.20
-- Created: 20:10 Pacific Standard Time, Tuesday 16 December, 2003
-- Command line: -fno-qualified-names -fno-imports -fno-export-lists -fkeep-hresult -fout-pointers-are-not-refs -c WideString.idl -o WideString.hs

module WideString where



import PointerPrim
import Pointer
import Foreign.Ptr
import HDirect
import Word         ( Word32 )
import Int
import IOExts

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
   -- Note: we're using the task allocator here.
  pwide <- primAllocMemory ((wlen + 1) * sizeofWideString)
  primStringToWide pstr (fromIntegral len) (castPtr pwide) wlen
  unmarshallWideString (castPtr pwide)

-- Sometimes a (wchar_t*) double up as holding a 16-bit (yep, no kidding) -
-- higher 16 bits have to be zero, lower 16 the val. We *love* this stuff.
word16ToWideString :: Word16 -> IO WideString
word16ToWideString w = 
  return (WideString (plusPtr nullPtr (fromIntegral w)))

nullWideString :: WideString
nullWideString = WideString (nullPtr)

-- Does not belong here - at all.

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

-- using 'Ptr a' is too weak, really - but avoids trivial
-- problems wrt WideString/Wchar_t confusion. ToDo: tidy up.
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 doesn't copy the wide string, it merely
-- fills in a pointer to the wide string.

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

-- is this correct?
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 () --(WideString pstr) = freeMemory pstr

freeWString :: WideString -> IO ()
freeWString (WideString pstr) = freeMemory pstr

sizeofWideString :: Word32
sizeofWideString = 2  -- not set in stone.

wideToStr :: WideString -> IO String
wideToStr wide = do
   pwide     <- marshallWideString wide
   (pstr,hr) <- wideToString (castPtr pwide)
   unmarshallString (castPtr pstr)


wideStringLen :: Ptr Char
              -> Word32
wideStringLen str =
  unsafePerformIO (prim_WideString_wideStringLen str)

foreign import stdcall "wideStringLen" prim_WideString_wideStringLen :: Ptr Char -> IO Word32
wideToString :: Ptr Wchar_t
             -> IO (Ptr Char, Int32)
wideToString wstr =
  do
    pstr <- allocBytes (fromIntegral sizeofPtr)
    o_wideToString <- prim_WideString_wideToString wstr pstr
    pstr <- doThenFree free readPtr pstr
    return (pstr, o_wideToString)

foreign import stdcall "wideToString" prim_WideString_wideToString :: Ptr Word16 -> Ptr (Ptr Char) -> IO Int32
lenWideString :: Ptr Wchar_t
              -> IO Int32
lenWideString wstr = prim_WideString_lenWideString wstr

foreign import stdcall "lenWideString" prim_WideString_lenWideString :: Ptr Word16 -> IO Int32
primStringToWide :: Ptr Char
                 -> Word32
                 -> Ptr Wchar_t
                 -> Word32
                 -> IO Int32
primStringToWide str len wstr wlen =
  prim_WideString_primStringToWide str
                                   len
                                   wstr
                                   wlen

foreign import stdcall "primStringToWide" prim_WideString_primStringToWide :: Ptr Char -> Word32 -> Ptr Word16 -> Word32 -> IO Int32