HaskellでWin32メッセージループをPeekMessageで制御してみる
こんどはEsa Ilari Vuokko氏製のDirectXバインディングを使ってみるを見ながらコピペしつつ修正していきます。
とりあえず、PeekMessageを使った後にMSG構造体の中身を見ることになるので、まずはMSG構造体のHaskell版を定義します。
data MSG = MSG { msg_hwnd :: HWND, msg_message :: UINT, msg_wParam :: WPARAM, msg_lParam :: LPARAM, msg_time :: DWORD, msg_pt :: POINT } deriving (Show, Eq) instance Storable MSG where sizeOf x = 28 alignment x = 4 peek p = do hwnd <- peekByteOff p 0 message <- peekByteOff p 4 wParam <- peekByteOff p 8 lParam <- peekByteOff p 12 time <- peekByteOff p 16 pt <- peekPOINT (p `plusPtr` 20) return $ MSG { msg_hwnd = hwnd, msg_message = message, msg_wParam = wParam, msg_lParam = lParam, msg_time = time, msg_pt = pt } poke p x = do pokeByteOff p 0 (msg_hwnd x) pokeByteOff p 4 (msg_message x) pokeByteOff p 8 (msg_wParam x) pokeByteOff p 12 (msg_lParam x) pokeByteOff p 16 (msg_time x) pokePOINT (p `plusPtr` 20) (msg_pt x)
そしてループするのですが、リンク先のソースの手順が地味に見慣れない(というかバグ?)ので少し修正します。
c_PeekMessageでメッセージを取れたかどうか戻り値を使って判定し、その結果で分岐するようにします。
昨日のエントリのpump関数を次のように変更。
pM_NOREMOVE = 0x0000 :: UINT pM_REMOVE = 0x0001 :: UINT pM_NOYIELD = 0x0002 :: UINT onIdle :: IO () onIdle = sleep 1 pump :: LPMSG -> IO () pump lpmsg = do ret <- c_PeekMessage lpmsg (maybePtr Nothing) 0 0 pM_REMOVE case ret of -1 -> putStrLn "error" 0 -> onIdle >> pump lpmsg otherwise -> do msg <- peek $ castPtr lpmsg when (msg_message msg /= wM_QUIT) $ do translateMessage lpmsg dispatchMessage lpmsg pump lpmsg
LPMSGは型がPtr ()なので、これをPtr MSGにキャストする必要があります。
相変わらずC言語でやってることと大差ないですね。