Programming Windows in Haskell
えー、いまさら何をやってんだという声も聞こえてきそうですが、普段Win32を使うことがとても多いので、Haskellで簡単なWin32のアプリを書いてみました。ちょっと長めなサンプルなので、コードは最後につけときます。
Win32でウィンドウを表示する基本的なプログラムの流れは以下のとおりです:
開始 ウィンドウクラスを登録。 ウィンドウを作成 ウィンドウを表示 メッセージをポンプする(以下ループ) キューからメッセージを取り出す ウィンドウプロシジャにディスパッチする ウィンドウクラスの登録を削除する 終了
ほぼ必要なものは、System.Win32とGraphics.Win32の下にあります。なんですが、不思議なことに、PostQuitMessage APIだけはライブラリ内でインポートが定義されていませんでした...そこで、Foreign Function Interface (FFI) を使ってAPIのプロトタイプを宣言しています。
pumpがいわゆるメッセージループなわけですが、キューからメッセージを取得するGetMessageはプロセス終了のメッセージであるWM_QUITをキューから取り出したときだけFalseを返すAPIです。そして、WM_QUITをメッセージキューにポストするのがFFIでインポートしなくてはいけなかったPostQuitMessageなわけです。つまり、PosQuitMessageを使わずにはWin32正規なウィンドウアプリの終了はできないはずなのですが、一体ほかのHaskell+Win32の人たちはどうやってアプリを書いてるんでしょう?書いていない?それとも、ほかのライブラリを使っている?
ではでは。
追記:アプリを起動するときにコンソールウィンドウが出ないようにするためには-optl-mwindowsをコンパイルするときに指定する必要があります。(GHCでの話ですが…ほかのコンパイラについては調べていません…)
module Main where import System.Win32.DLL (getModuleHandle) import Graphics.Win32 import Graphics.Win32.Message import Graphics.Win32.Window import Data.Int import Data.Maybe import Control.Monad import Foreign.C.String foreign import stdcall "PostQuitMessage" postQuitMessage :: Int32 -> IO () main = do let clsName = mkClassName "My Window Class" hinst <- getModuleHandle Nothing whiteBrush <- getStockBrush wHITE_BRUSH curArrow <- loadCursor Nothing iDC_ARROW mAtom <- registerClass ( cS_DBLCLKS, hinst, -- HINSTANCE Nothing, -- Maybe HICON Just curArrow, -- Maybe HCURSOR Just whiteBrush,-- Maybe HBRUSH Nothing, -- Maybe LPCTSTR clsName) when (isJust mAtom) $ do hwnd <- createWindow clsName "test window" (wS_THICKFRAME + wS_CAPTION + wS_SYSMENU) Nothing Nothing Nothing Nothing Nothing Nothing hinst wndProc showWindow hwnd sW_SHOWNORMAL updateWindow hwnd allocaMessage pump unregisterClass clsName hinst pump lpmsg = do fContinue <- getMessage lpmsg Nothing when fContinue $ do translateMessage lpmsg dispatchMessage lpmsg pump lpmsg render :: HWND -> HDC -> IO () render hwnd hdc = do setBkMode hdc tRANSPARENT setTextColor hdc $ rgb 0 0 0 textOut hdc 5 5 "hello world!" wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT wndProc hwnd wm wp lp | wm == wM_KEYDOWN = doFinish | wm == wM_LBUTTONDOWN = doFinish | wm == wM_DESTROY = postQuitMessage 0 >> return 0 | wm == wM_PAINT = onPaint | otherwise = defWindowProc (Just hwnd) wm wp lp where doFinish = sendMessage hwnd wM_CLOSE 1 0 >> return 0 onPaint = allocaPAINTSTRUCT $ \ lpps -> do hdc <- beginPaint hwnd lpps render hwnd hdc endPaint hwnd lpps return 0