椿の日記

たぶんプログラムの話をします

HaskellでWin32プログラミング

少し思い立って、HaskellでWin32プログラミングをするにはどうするんだろう、と思ってやってみました。


こちらのサイトが非常に参考になりましたので参考…というよりほとんどコピペ。
http://d.hatena.ne.jp/Otter_O/20080523/1211527903

{-# LANGUAGE ForeignFunctionInterface #-}

import Graphics.Win32
import Graphics.Win32.Window
import System.Win32.Types
import System.Win32.DLL (getModuleHandle)
import Control.Monad

foreign import stdcall "PostQuitMessage" postQuitMessage :: Int -> IO ()

clsName :: LPCTSTR
clsName = mkClassName "My Window Class"

registerMyClass :: IO (Maybe ATOM)
registerMyClass = do
    hinst      <- getModuleHandle Nothing
    whiteBrush <- getStockBrush wHITE_BRUSH
    curArrow   <- loadCursor Nothing iDC_ARROW
    let style = cS_HREDRAW + cS_VREDRAW
    let wc = (style,             -- ClassStyle
              hinst,             -- HINSTANCE
              Nothing,           -- Maybe HICON
              Just curArrow,     -- Maybe HCURSOR
              Just whiteBrush,   -- Maybe HBRUSH
              Nothing,           -- Maybe LPCTSTR
              clsName)
    registerClass wc

unregisterMyClass :: IO ()
unregisterMyClass = do
    hinst    <- getModuleHandle Nothing
    unregisterClass clsName hinst

createMyWindow :: IO HWND
createMyWindow = do
    let style = wS_THICKFRAME + wS_CAPTION + wS_SYSMENU
    hinst    <- getModuleHandle Nothing
    hwnd     <- createWindow
      clsName              -- LPCTSTR        (lpszClassName)
      "test window"        -- String         (lpszCaption)
      style                -- WindowStyle    (dwStyle)
      Nothing              -- Maybe Pos      (left)
      Nothing              -- Maybe Pos      (top)
      Nothing              -- Maybe Pos      (width)
      Nothing              -- Maybe Pos      (height)
      Nothing              -- Maybe HWND     (hwndParent)
      Nothing              -- Maybe HMENU    (hwndMenu)
      hinst                -- HINSTANCE      (hInstance)
      wndProc              -- WindowClosure
    return hwnd

onDestroy :: IO LRESULT
onDestroy = postQuitMessage 0 >> return 0

wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
wndProc hwnd wm wp lp
    | wm == wM_DESTROY = onDestroy
    | otherwise        = defWindowProc (Just hwnd) wm wp lp

pump :: LPMSG -> IO ()
pump lpmsg = do
  fContinue <- getMessage lpmsg Nothing
  when fContinue $ do
    translateMessage lpmsg
    dispatchMessage lpmsg
    pump lpmsg

main :: IO ()
main = do
    registerMyClass
    hwnd <- createMyWindow
    showWindow hwnd sW_SHOWNORMAL
    updateWindow hwnd
    allocaMessage pump
    unregisterMyClass

ほんとに必要最小限という感じでウィンドウを開くところまで、です。
CでWin32アプリケーションを書いたことがあれば、大体どの処理がどれに該当しているのか分かります。


少しこの辺が特別ですかね。

  • PostMessage系がポーティングがされてないので、自分でforeign importする。
  • allocaMessageでMSG構造体の領域を確保して値の入出力はメモリを介して行う。

allocaMessageのところはなんとも手続き的です…
まあ、この辺はあまり本質的ではないので、とりあえず動けばOKということで。


ここから少しずつ改造していきたいと思います。