Closed13

HaskellとWin32APIでウィンドウを表示する

Haskell
win32api
Kazuki MiyanishiKazuki Miyanishi

GHCupでHaskell開発環境をインストール

Windows環境にGHCupでHaskell環境をインストールする。

GHCupの公式ページにあるPowerShell用インストールスクリプトを実行する。

https://www.haskell.org/ghcup/

Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { & ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -Interactive -DisableCurl } catch { Write-Error $_ }

PS C:\Users\kazuk> Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { & ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -Interactive -DisableCurl } catch { Write-Error $_ }
Picked C:\ as default Install prefix!
Welcome to Haskell!

This script can download and install the following programs:
  * ghcup - The Haskell toolchain installer
  * ghc   - The Glasgow Haskell Compiler
  * msys2 - A linux-style toolchain environment required for many operations
  * cabal - The Cabal build tool for managing Haskell software
  * stack - (optional) A cross-platform program for developing Haskell projects
  * hls   - (optional) A language server for developers to integrate with their editor/IDE

Please note that ANTIVIRUS may interfere with the installation. If you experience problems, consider
disabling it temporarily.

Where to install to (this should be a short Path, preferably a Drive like 'C:\')?
If you accept this path, binaries will be installed into 'C:\ghcup\bin' and msys2 into 'C:\ghcup\msys64'.
Press enter to accept the default [C:\]:
...

MinGWのコンソールが開いて、そっちでghcのインストールが進んでいる。

[ Info  ] verifying digest of: ghc-9.6.7-x86_64-unknown-mingw32.tar.xz
[ Info  ] Unpacking: ghc-9.6.7-x86_64-unknown-mingw32.tar.xz to C:/ghcup\tmp\ghcup-4cb72a514d18efa6
[ Info  ] Installing GHC (this may take a while)
[ Info  ] Merging file tree from "C:/ghcup\tmp\ghcup-4cb72a514d18efa6\ghc-9.6.7-x86_64-unknown-mingw32" to "C:/ghcup\ghc\9.6.7"

最後になんか失敗したみたいなエラーメッセージが出たけど、ちゃんと見る前に閉じてしまった。

ghcup tuiからインストールし直してみた。

[ Info  ] verifying digest of: ghc-9.6.7-x86_64-unknown-mingw32.tar.xz
[ Info  ] Unpacking: ghc-9.6.7-x86_64-unknown-mingw32.tar.xz to C:\ghcup\tmp\ghcup-c29af95e451ff456
[ Info  ] Installing GHC (this may take a while)
[ Info  ] Merging file tree from "C:\ghcup\tmp\ghcup-c29af95e451ff456\ghc-9.6.7-x86_64-unknown-mingw32" to "C:\ghcup\ghc\9.6.7"
[ Info  ] HLS is not supported for 9.6.7 yet. To build from source, run:
[ ...   ]   ghcup compile hls -g 2.9.0.1 --ghc 9.6.7 --cabal-update -- --constraint="ghc-lib-parser == 9.8.5.20250214" --index-state="2025-02-14T12:50:38Z"
Success
[ Info  ] downloading: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.9.yaml as file C:\ghcup\cache\ghcup-0.0.9.yaml

> ghc --version
The Glorious Glasgow Haskell Compilation System, version 9.6.7

できたっぽい。

Kazuki MiyanishiKazuki Miyanishi

FFIでWin32APIのMessageBoxA関数を呼び出す

FFIでMessageBoxA関数を呼び出す。

messagebox.hs
{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.String
import Foreign.C.Types

foreign import ccall "MessageBoxA"
  c_MessageBox :: Ptr () -> CString -> CString -> CUInt -> IO CInt

main :: IO ()
main = do
  title <- newCString "Haskell FFI"
  msg   <- newCString "Hello from Win32API!"
  _ <- c_MessageBox nullPtr msg title 0
  free title
  free msg

> ghc messagebox.hs -luser32

> .\messagebox.exe

Kazuki MiyanishiKazuki Miyanishi

FFIでWin32APIのMessageBoxWを呼び出す

日本語（UTF-16）対応版。

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.String
import Foreign.C.Types

foreign import ccall "MessageBoxW"
  c_MessageBox :: Ptr () -> CWString -> CWString -> CUInt -> IO CInt

main :: IO ()
main = do
  title <- newCWString "タイトル"
  msg <- newCWString "こんにちは"
  _ <- c_MessageBox nullPtr msg title 0
  free title
  free msg

Kazuki MiyanishiKazuki Miyanishi

Graphics.Win32.MiscモジュールのmessageBox関数を利用する

Haskellは標準でWin32というパッケージを持っていて、そのパッケージのGraphics.Win32.MiscモジュールにあるmessageBox関数を使えば、自前でFFIを書かなくてもメッセージボックスの表示ができる。

https://hackage-content.haskell.org/package/Win32-2.14.2.1/docs/Graphics-Win32-Misc.html

import Graphics.Win32.Misc (mB_OK, messageBox)

main :: IO ()
main = do
  messageBox Nothing "メッセージです。" "タイトル" mB_OK
  return ()

とてもシンプルになった。

Kazuki MiyanishiKazuki Miyanishi

単純なウィンドウ表示までの手順の全体像を把握

単純なウィンドウ表示のプログラムをCで書いた場合は以下のようになる。

Cでウィンドウ表示する例
#include <windows.h>

int WINAPI WinMain(HINSTANCE hInst, HINSTANCE _, LPSTR _, int nCmdShow) {
    WNDCLASS wc = {0};
    wc.lpfnWndProc   = DefWindowProc;
    wc.hInstance     = hInst;
    wc.lpszClassName = "MyWndClass";

    RegisterClass(&wc);

    HWND hwnd = CreateWindow(
        wc.lpszClassName,
        "単純なウィンドウ",
        WS_OVERLAPPEDWINDOW,
        CW_USEDEFAULT, CW_USEDEFAULT, 300, 200,
        NULL, NULL, hInst, NULL
    );

    ShowWindow(hwnd, nCmdShow);
    UpdateWindow(hwnd);

    MSG msg;
    while (GetMessage(&msg, NULL, 0, 0)) {
        TranslateMessage(&msg);
        DispatchMessage(&msg);
    }

    return 0;
}

手順は以下のとおり。

  1. WNDCLASS構造体のデータを用意
  2. RegisterClass関数でウィンドウクラスを登録
  3. CreateWindow関数でウィンドウを作成
  4. ShowWindow関数でウィンドウを表示
  5. UpdateWindow関数で初回の描画要求
  6. GetMessage関数でウィンドウメッセージをループで取得し続ける
    1. 終了のウィンドウメッセージ（WM_QUIT）が取得されたらループを脱出する
    2. TranslateMessage関数でキー入力イベントから文字入力イベントを送出（物理的なキー入力イベントのみを使用する場合は不要）
    3. DispatchMessage関数で取得したウィンドウイベントをウィンドウプロシージャに送出

WNDCLASSデータの用意

WNDCLASS構造体は、Haskell側ではGraphics.Win32.Windowモジュールで以下のような7つの要素のタプル型のエイリアス型として定義されている。

Haskell
type WNDCLASS =
 (ClassStyle,    -- style
  HINSTANCE,     -- hInstance
  Maybe HICON,   -- hIcon
  Maybe HCURSOR, -- hCursor
  Maybe HBRUSH,  -- hbrBackground
  Maybe LPCTSTR, -- lpszMenuName
  ClassName)     -- lpszClassName

任意の項目はMaybeになっているので、省略する場合はNothingを渡す。

Kazuki MiyanishiKazuki Miyanishi

インスタンスハンドルの取得

HaskellでWinMain関数は定義できないので、インスタンスハンドルを取得するには別の手段としてgetModuleHandle関数を使う。

getModuleHandle関数はSystem.Win32.DLLモジュールで定義されている。

https://hackage-content.haskell.org/package/Win32-2.14.2.1/docs/System-Win32-DLL.html#v:getModuleHandle

getModuleHandle :: Maybe String -> IO HMODULE

第1引数はモジュール名（実行ファイル名）を指定するが、Nothingを指定したら現在のプロセスの実行ファイルのハンドルが返される。

HMODULEは

type HMODULE = Ptr ()

で、PtrはFFI用のForeign.Ptrモジュールで定義されている型構築子。

試しに、getModuleHandleで取得したモジュールハンドルの値を表示するだけのプログラムの実行を試してみる。

import System.Win32.DLL (getModuleHandle)

main :: IO ()
main = do
  hModule <- getModuleHandle Nothing
  print hModule

0x00007ff790150000

値は環境、状況によって異なるけど、値が取得できた。

WNDCLASSに渡すインスタンスハンドルの型がHINSTANCEで、getModuleHandleで得られる値の型がHMODULEだけど、どちらもPtr ()のエイリアスなので問題ない。

type HINSTANCE = Ptr ()
type HMODULE = Ptr ()
Kazuki MiyanishiKazuki Miyanishi

ClassStyle

ClassStyleはUINTのエイリアスで、ウィンドウの挙動に関する指定がビットフラグによって可能だけど、今回は省略するので0を指定する。

ClassName

クラス名はCreateWindowするときのウィンドウクラスの識別子で、とりあえず適用な名前で良いが、こちらの型はClassNameとなっている。

ClassNameの型の定義は

type ClassName = LPCTSTR

となっていて、

type LPCTSTR = LPTSTR

type LPTSTR = Ptr TCHAR

type TCHAR = CWchar

CWcharはForeign.C.Typesの型で、これ以上は追わないが、Graphics.Win32.WindowにあるmkClassName関数を使えばStringからClassNameを作ることができる。

mkClassName :: String -> ClassName

WNDCLASS

結果、今回のWNDCLASSの値は以下のようにする。

hModule <- getModuleHandle Nothing
let wndClass =
      ( 0,
        hModule,
        Nothing,
        Nothing,
        Nothing,
        Nothing,
        mkClassName "SimpleWindow"
      )
Kazuki MiyanishiKazuki Miyanishi

ウィンドウクラスの登録

RegisterClass関数は、Haskell側ではregisterClass関数として定義されており、以下のような型として定義されている。

registerClass :: WNDCLASS -> IO (Maybe ATOM)

ATOMという型はSystem.Win32.Typesモジュールで定義されていて、

type ATOM = WORD

type WORD = Word16

という定義になっている。Word16はHaskell標準のData.Wordにある型。

このATOMの値は登録したクラスを一意に識別する値ということだけど、例ではこの値を使用していない。

先に用意したWNDCLASSの値をregisterClass関数に渡す。

import Graphics.Win32.Window (mkClassName, registerClass)
import System.Win32.DLL (getModuleHandle)

main :: IO ()
main = do
  hModule <- getModuleHandle Nothing
  let wndClass =
        ( 0,
          hModule,
          Nothing,
          Nothing,
          Nothing,
          Nothing,
          mkClassName "SimpleWindow"
        )
  registerClass wndClass
  return ()

これでウィンドウクラスの登録ができる。

登録しただけなので、何も起きずにそのままプログラムは終了する。

Kazuki MiyanishiKazuki Miyanishi

ウィンドウを作成する

Graphics.Win32.WindowのcreateWindow関数でウィンドウを作成する。

createWindow
  :: ClassName -> String -> WindowStyle ->
     Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos ->
     Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure ->
     IO HWND

最後の引数に、Win32APIのCreateWindow関数には無いWindowClosureというのがある。

元々ウィンドウプロシージャの指定はWNDCLASS構造体で行うものだけれど、Haskell側ではウィンドウプロシージャの指定はWNDCLASSから行うのではなく、このcreateWindowから指定するようになっているようで、それがこのWindowClosureのようである。

元のWin32APIのCreateWindow関数にはこのWindowClosureに相当する引数が無いのに、なぜここで関数を指定してウィンドウプロシージャとして呼ばれるようになるのかについては、内部でいろいろやっているようで、とりあえずここで指定したWindowsClosureはウィンドウプロシージャとして呼ばれるようになるようだ。

このWindowClosureはMaybeじゃないので、アプリ側で何もしない場合でも関数を渡す必要がある。

WindowClosureの型は以下の通り。

type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT

例にあげたCのサンプルでは、ウィンドウプロシージャとしてDefWindowProcを直接指定してウィンドウの標準の挙動をしてもらうようにしている。Haskell側でもdefWindowProc関数が用意されているが、第1引数のMaybe HWNDがWindowClosureのHWNDと異なる。

defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT

なので、標準動作のみをするウィンドウプロシージャとして、HWNDをJustしてあげる必要がある。

windowClosure :: WindowClosure
windowClosure hWnd = defWindowProc (Just hWnd)

これを踏まえてcreateWindow関数を呼び出す。

hWnd <-
  createWindow
    className
    "ウィンドウタイトル"
    wS_OVERLAPPEDWINDOW
    Nothing
    Nothing
    Nothing
    Nothing
    Nothing
    Nothing
    hModule
    windowClosure

これでウィンドウの作成自体はできるようになる。表示はまだされない。

Kazuki MiyanishiKazuki Miyanishi

ウィンドウの表示

ウィンドウを表示するにはshowWindow関数を使用する。

showWindow :: HWND -> ShowWindowControll -> IO Bool

ShowWindowControllは、とりあえずsW_SHOWNORMALで良い。

showWindow hWnd sW_SHOWNORMAL

ウィンドウ内の描画を即座に実行してもらうために、updateWindow関数を呼ぶ。

updateWindow :: HWND -> IO ()

updateWindow hWnd

ここまででウィンドウの表示は行われるが、即座にプログラムが終了してウィンドウも一瞬で閉じられる。

Kazuki MiyanishiKazuki Miyanishi

メッセージループ

プログラムが即座に終了してしまわないようにするために、メッセージループをさせる。

まず、メッセージループ用の関数を用意し、メッセージを受け取るためのメモリを確保する。
メッセージを受け取るためのメモリの確保はallocaMessage関数を使用する。
これはWin32APIではなくHaskellのWin32パッケージの独自のもの。

allocaMessage :: forall a. (LPMSG -> IO a) -> IO a

LPMSGがメッセージ情報が入るメモリのポインタ。

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> messageLoop

次にウィンドウメッセージを取得をする。ウィンドウメッセージの取得はgetMessage関数を使う。

getMessage :: LPMSG -> Maybe HWND -> IO Bool

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> do
  getMessage msg Nothing
  messageLoop

ウィンドウメッセージでプログラムの終了のメッセージ（WM_QUIT）が来た場合は、getMessage関数はFalseを返し、そうでない場合はTrueを返すので、Trueが来るときに限りメッセージループを継続するようにする。

import Control.Monad (when)

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> do
  continue <- getMessage msg Nothing
  when continue $ do
    messageLoop

取得したメッセージをウィンドウプロシージャに送るためにdispatchMessage関数を使用する。

dispatchMessage :: LPMSG -> IO LONG

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> do
  continue <- getMessage msg Nothing
  when continue $ do
    dispatchMessage msg
    messageLoop

今回必須ではないが、キー入力メッセージを文字入力メッセージ変換するためにtranslateMessage関数を呼ぶ。

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> do
  continue <- getMessage msg Nothing
  when continue $ do
    translateMessage msg
    dispatchMessage msg
    messageLoop

main関数の最後の方でmessageLoopを呼ぶことでメッセージループが始まり、ウィンドウが表示されるようになる。

Kazuki MiyanishiKazuki Miyanishi

ウィンドウを閉じたときにプログラムを終了させる

ウィンドウプロシージャがdefWindowProcのままだと、ウィンドウを閉じたときにプログラムが終了されない。なので、ウィンドウが閉じられたときにプログラムが終了されるようにする必要がある。

メッセージループを抜け出すことでプログラムを終了させられるが、メッセージループではgetMessageがTrueを返す限りループするようになっていた。

messageLoop = allocaMessage $ \msg -> do
  continue <- getMessage msg Nothing
  when continue $ do
    -- 略

postQuitMessage関数を呼ぶことで、getMessageがFalseを返すようにできる。

postQuitMessage :: Int -> IO ()

Intの引数を1つ取るようになっていて、これは終了コードを表すので、特に問題がなければこれは0で良い。

postQuitMessage 0 -- メッセージループを終了させる

ウィンドウを閉じたらwM_DESTROYというウィンドウメッセージが送出されるので、ウィンドウプロシージャでまずそのメッセージを捉えて、そこでpostQuitMessageを呼んであげる。

windowClosure hWnd msg w l
  | msg == wM_DESTROY =
      postQuitMessage 0
      return 0

windowClosureの型はWindowClosureという関数の型で、その戻り値の型はIO LRESULTで、postQuitMessageの戻り値の型はIO ()で合わないので、return 0で型に合う戻り値にする。

また、wM_DESTROY以外のウィンドウメッセージのときはデフォルト動作としてdefWindowProcする必要がある。

windowClosure :: WindowClosure
windowClosure hWnd msg w l
  | msg == wM_DESTROY = do
      postQuitMessage 0
      return 0
  | otherwise = do
      defWindowProc (Just hWnd) msg w l
Kazuki MiyanishiKazuki Miyanishi

全体のプログラム

import Control.Monad (when)
import Graphics.Win32 (iDC_ARROW, loadCursor)
import Graphics.Win32.Message (wM_DESTROY)
import Graphics.Win32.Window
  ( WindowClosure,
    allocaMessage,
    createWindow,
    defWindowProc,
    dispatchMessage,
    getMessage,
    mkClassName,
    registerClass,
    sW_SHOWNORMAL,
    showWindow,
    translateMessage,
    updateWindow,
    wS_OVERLAPPEDWINDOW,
  )
import Graphics.Win32.Window.PostMessage (postQuitMessage)
import System.Win32.DLL (getModuleHandle)

windowClosure :: WindowClosure
windowClosure hWnd msg w l
  | msg == wM_DESTROY = do
      postQuitMessage 0
      return 0
  | otherwise = do
      defWindowProc (Just hWnd) msg w l

messageLoop :: IO ()
messageLoop = allocaMessage $ \msg -> do
  continue <- getMessage msg Nothing
  when continue $ do
    translateMessage msg
    dispatchMessage msg
    messageLoop

main :: IO ()
main = do
  hModule <- getModuleHandle Nothing
  hCursor <- loadCursor Nothing iDC_ARROW
  let className = mkClassName "SimpleWindow"
  let wndClass =
        (0, hModule, Nothing, Just hCursor, Nothing, Nothing, className)

  registerClass wndClass

  hWnd <-
    createWindow
      className
      "ウィンドウタイトル"
      wS_OVERLAPPEDWINDOW
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      hModule
      windowClosure

  showWindow hWnd sW_SHOWNORMAL
  updateWindow hWnd

  messageLoop

  return ()

モナドを活用した形に変えられそうな部分もあるが、一旦ウィンドウを表示するという目標は達成できた。

このスクラップは19日前にクローズされました