Seth Kurtzberg wrote:
Juan Carlos Arevalo Baeza wrote:
Thanx! That's exactly what I needed. The swhich was undocumented! :-P
:-) I understand the caveats well enough. You can avoid the exceptions very easily using this code:
---8<-------------------------------------- import Foreign.C.Types import Foreign.C.String
foreign import ccall unsafe "HsBase.h __hscore_open" c_open :: CString -> CInt -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h dup2" dup2 :: CInt -> CInt -> IO CInt
open fname oflag pmode = withCString fname $ \c_fname -> c_open c_fname oflag pmode
main = fd <- open "nul" 2 0 dup2 fd 0 dup2 fd 1 dup2 fd 2
I guess Windows can make even Haskell programs look ugly. Or at the very least esthetically unpleasing. :)
He he... I seriously doubt that Windows has much to do with the uglyness in thic case, as the above code is just a workarround for a shortcoming in the compiler more than anything else, but yes. Win32 programming is very imperative, so it doesn't look very good in Haskell. Nothing much to do about that. OpenGL is just as bad (or worse - it adds the concept of the hidden "current" context). Incidentally, given that the Win32 (and HGL too!) support in GHC 6.4 was so completely broken that it doesn't even compile, I've been learning FFI by implementing my own bindings for Win32. I took to porting Raymond Chen's chinese dictionary example: http://blogs.msdn.com/oldnewthing/archive/2005/04/22/410773.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/10/415991.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/11/416430.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/13/417183.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/16/417865.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/18/419130.aspx http://blogs.msdn.com/oldnewthing/archive/2005/05/19/420038.aspx http://blogs.msdn.com/oldnewthing/archive/2005/06/13/428534.aspx http://blogs.msdn.com/oldnewthing/archive/2005/06/14/428892.aspx http://blogs.msdn.com/oldnewthing/archive/2005/06/15/429338.aspx http://blogs.msdn.com/oldnewthing/archive/2005/07/11/437522.aspx http://blogs.msdn.com/oldnewthing/archive/2005/07/12/437974.aspx http://blogs.msdn.com/oldnewthing/archive/2005/07/13/438381.aspx http://blogs.msdn.com/oldnewthing/archive/2005/08/11/450383.aspx http://blogs.msdn.com/oldnewthing/archive/2005/08/12/450818.aspx and added all the platform support I needed into Haskell to get the program working. It works very well: I didn't even need to use any C code at all, just FFI. There's something to be said about the possibility of doing the mesage-handling callback like so (and don't look at the hardcoded peeks and pokes, please ;-)): ---8<--------------------------------------- mainWindowProc :: IORef MainWindowData -> WNDPROC mainWindowProc wdataRef hwnd msg wParam lParam ... | msg == wM_PAINT = do withPaint hwnd $ \dc ps -> do return 0 return 0 | msg == wM_CLOSE = do postQuitMessage 0 return 1 | msg == wM_COMMAND = do let id = loWORD wParam let cmd = CMD $ hiWORD wParam when_ (id == 2 && cmd == eN_CHANGE) $ do refilterRef wdataRef defWindowProc hwnd msg wParam lParam | msg == wM_NOTIFY = do let p = nullPtr `plusPtr` fromIntegral lParam wdata <- readIORef wdataRef let lvHwnd = lvWindow wdata childHwnd <- peekByteOff p 0 --childId <- peekByteOff p 4 code <- peekByteOff p 8 case code of _| code == lVN_GETDISPINFO -> do i <- peekByteOff p 16 :: IO INT when_ ((i >= 0) && (i < (fromIntegral $ dictIndexSize wdata))) $ do mask <- peekByteOff p 12 when_ ((mask .&. lVIF_TEXT) /= LVIF 0) $ do let (trad, simp, pinyin, english) = dict wdata ! (dictIndex wdata ! fromIntegral i) col <- peekByteOff p 20 :: IO INT pokeByteOff p 32 $ case col of _| col == cOL_TRAD -> trad _| col == cOL_SIMP -> simp _| col == cOL_PINYIN -> pinyin _| col == cOL_ENGLISH -> english when_ ((mask .&. lVIF_IMAGE) /= LVIF 0) $ do pokeByteOff p 40 (-1 :: INT) when_ ((mask .&. lVIF_STATE) /= LVIF 0) $ do pokeByteOff p 24 (0 :: UINT) return 0 _| code == nM_CUSTOMDRAW && lvHwnd == childHwnd -> do drawStage <- peekByteOff p 12 case drawStage of _| drawStage == cDDS_PREPAINT -> return cDRF_NOTIFYITEMDRAW _| drawStage == cDDS_ITEMPREPAINT -> do clrText <- peekByteOff p 48 writeIORef wdataRef $ wdata { normalTextColor = clrText } return cDRF_NOTIFYSUBITEMDRAW _| drawStage == cDDS_SUBITEMPREPAINT -> do itemSpec <- peekByteOff p 36 :: IO DWORD subItem <- peekByteOff p 56 if subItem == cOL_PINYIN && itemSpec < (fromIntegral $ arrayLength $ dict wdata) then do let (ctrad, csimp, cpinyin, cenglish) = dict wdata ! fromIntegral itemSpec pinyin <- peekCWString cpinyin if pinyin == "" || head pinyin == 'a' then pokeByteOff p 48 $ rgb 0x80 0 0x80 else pokeByteOff p 48 $ normalTextColor wdata else pokeByteOff p 48 $ normalTextColor wdata return cDRF_DODEFAULT otherwise -> do return cDRF_DODEFAULT otherwise -> do return 0 | msg == wM_NOTIFYFORMAT = do return nFR_UNICODE | otherwise = defWindowProc hwnd msg wParam lParam ---8<--------------------------------------- Hopefully, I'll find better ways to expose different things to the Haskell program. Like proper lazy access to parameters passed by pointer to structure (I started a thread about this in Haskell Cafe), or a better way to dispatch the messages (Hash?). JCAB