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
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
