imHo RSSフィード

2009-05-10

「Programming in Haskell」の読書感想文

遅くなって本当に申し訳ありませんが、jj1bdxさんにいただいた「Programming in Haskell」の感想を書きます。

Programming in Haskell
Programming in Haskell
posted at 09.04.25
Graham Hutton
Cambridge Univ Pr (Txp)
売り上げランキング: 5337

まずもういきなり序文

... ソフトウェアデザインの構築には2通りある:1つは"どうみても"欠けているものがないほど単純に作る方法で、もう1つは"明らかな"欠陥がないほど複雑に作る方法だ。はじめの方法の方がよっぽど難しい。

Tony Hoare, 1980 ACM Turing Award Lecture

でググイと心をつかまれました。そしてその言葉どおり、本書に出てくるプログラムはほとんど長くても3行の関数で作られていつつちゃんと機能を組み上げている。一つもわからない点がないところまで機能分解してそれをうまく組み合わせて階層化してプログラムを作り上げていく。これがマジですごい。関数は1個につき3行まで!これは常に心がけよう。

以下、箇条書き:

良い点
  • 完璧な入門書
    • プログラムの知識を前提としてない
  • 自己完結してる
    • 突然他の言語を引き合いに出して「その言語とこう違う」とか述べない
  • 簡潔な説明
    • 冗長じゃない
    • ボリュームが抑えられるので気軽に読める
  • 抽象的な思考法を育てる
  • 余計な説明がない
  • 章の構成が練られてる
    • 型とクラスとか関数とか、重要な項目をちゃんと最初に持ってきてる
  • つまづきそうな再帰や高階関数は懇切丁寧に説明してる
悪い点
  • 値段が高い
    • 170ページほどの薄い本だけどハードカバーは定価で$115、ソフトカバーでも$45もする。これが理由で、いい本だろうとわかっていながら自分は購入に踏み切れなかった…。1500〜2000円くらいだったら即買いできるんだけど…。
  • 多少数学の知識を必要とする
    • 記法程度のものですが
  • 説明の都合だと思うけど、8章で作るパーサの演算子が右結合になってるのが激しく気になる

はっきりいって、俺が今まで読んだ全てのプログラミング本の中で、掛け値なしで1番いい本だと断言できる。超オススメ。

おおっとここで久しぶりに公式ページを見て知った耳寄り情報:

Programming in Haskell

A Japanese version is currently in preparation.

Programming in Haskell

キタ━━━━(゜∀゜)━━━━ッ!!

2009-05-04

「『本物のプログラマはHaskellを使う』読者の集い」に参加

ShiraishiSeminar

今日の発表資料:

http://www.slideshare.net/mokehehe/super-monao-bros-in-hasell

  • 白石さんセミナーというところに無理やり発表させていただいた、のだけどモニタ出力できなかったり持ち時間の5分をオーバーしたりいろいろひどかった。本当にテキパキやらないと5分はあっという間だなぁ。
  • ITProの連載を見て想定はしてたけど、内容難しかったなぁ。あれだけの広く深い知識をどうやって得てるのか。Wikiとかメーリングリストといってたけど、全部目を通してるのかなぁ。
  • id:TTSYさんにお会いしてお話できたので満足
  • 高速化の話:白石さんの第一声が、「まずコンパイラオプションを全て知ること」うへー

2009-04-25

foldl と foldr はどちらが速いのか

畳み込みを左から計算する foldl と右から計算する foldr ではどちらが速いのか

foldl
main = print $ foldl (+) 0 [1..500000]

結果:0.156s

foldr
main = print $ foldr (+) 0 [1..500000]

結果:1.288s

foldl の方が断然速い。数を倍の1000000に増やすと foldl は計算できるのに対し foldr は Stack space overflow を起こす。

置き換えモデルで比べてみる
foldlfoldr
foldl (+) 0 [1,2,3]foldr (+) 0 [1,2,3]
foldl (+) (0 + 1) [2,3]1 + (foldr (+) 0 [2,3])
foldl (+) ( (0 + 1) + 2) [3]1 + (2 + (foldr (+) 0 [3]))
foldl (+) (((0 + 1) + 2) + 3) []1 + (2 + (3 + (foldr (+) 0 [])))
( (0 + 1) + 2) + 31 + (2 + (3 + 0))
(1 + 2) + 31 + (2 + 3)
3 + 31 + 5
66

どちらも段数は同じ。置き換えモデルでは説明できない。

なぜ foldl の方がメモリ消費量が少なくてすむのか

まったくの推測なんだけど、foldl の場合は foldl の展開が行われると古い計算はまったく必要なくなるいわば末尾呼び出し相当なのに対し、foldr の場合は foldr を1段展開して組み込みの + 演算を行おうとしたときに右辺がまださらに簡約できるので、+ の計算を継続として作成してから残りの foldr の展開をするから、継続を生成する分メモリの消費量が多くなりガベコレが多くなり遅くなるんではないか。

Haskellで勘違いしてたこと

ghcでビルドするときに-Wallをつけてwarningをすべて表示するようにして、いまさらにして初めてわかったこと:

caseでotherwiseを使うのはまちがい
	nt = case pltype of
		SmallMonao	-> SuperMonao
		SuperMonao	-> FireMonao
		otherwise	-> pltype	-- まちがい!

otherwiseはガードのときに使う、というか単にotherwise = Trueと定義されてるだけなので、シャドウされた変数パターンとして捕捉されてるだけだった。正しくはワイルドカードを使って

	nt = case pltype of
		SmallMonao	-> SuperMonao
		SuperMonao	-> FireMonao
		_		-> pltype
caseをRubyやSchemeのcaseと混同して、束縛された名前でマッチできると思ってた

ウィンドウメッセージを処理するのに

-- まちがい
wndProc hWnd msg wParam lParam =
	case msg of
		wM_DESTROY	-> postQuitMessage 0 >> return 0
		_		-> defWindowProc (Just hWnd) msg wParam lParam

とかやろうとしてしまったが、二重Warning

Main.hs:101:1:
    Warning: Pattern match(es) are overlapped
             In a case alternative: _ -> ...

caseやパターンマッチは値(リテラル)でのマッチはできるけど、定値バインドでマッチしようとしても単にシャドウするだけなのですべてにマッチしてしまう。この場合はガードを使って

wndProc hWnd msg wParam lParam
	| msg == wM_DESTROY	= postQuitMessage 0 >> return 0
	| otherwise		= defWindowProc (Just hWnd) msg wParam lParam

とする。

Esa Ilari Vuokko氏製のDirectXバインディングを使ってみる

f:id:mokehehe:20090425102501p:image:right

今は公開されてないみたいだけど、以前Esa Ilari Vuokkoという方がHaskellのDirectXバインディングを公開していた、とshelarcyさんに教えていただいた。

ソースをちょろっとみたところ、すごくちゃんと作ってある。つーかむちゃくちゃ気合入ってて、なぜかC言語のパーサ(FFI解析用?)やHLSLのシェーダのパーサまで入ってたりする。

ビルドできるか試してみる。

準備

このライブラリはMinGW/MSYS用だということで、READMEに書いてあるとおりDirectXのライブラリをMinGW用に変換する:

cd $DXSDK
mkdir Mingw
cd Mingw
cp ../Lib/x86/*.lib .
rm DxErr*.lib
ls | xargs -n 1 reimp
  • reimpというコマンドがライブラリ変換のツールで、実行ファイルはmingw-utilsに含まれている
ビルドしてみる

作られたのがGHC6.4の頃らしくて、パッケージシステムが変更になっていてSetupのコンパイルに失敗してしまう。これはSetup.hsのmainが

main = defaultMainWithHooks defaultUserHooks{preConf=conf, postConf=ok}
    where
        ok _ _ _ _ = return ExitSuccess
        ...

のようになっているのが、UserHooksのpostConfの戻り値の型が()になったみたいなので

        ok _ _ _ _ = return ()

に変更する。するとSetupのビルドができた。

baseのビルド

そしてREADMEのとおりbaseのビルドも通った。install時にLICENSEファイルがなくてエラーが出るのでルートからコピーしてインストール。

d3dのビルド

続きが書いてないけど、d3dに移ってビルドしようとするとエラー:

root@ADMIN ~/dx9/d3d
$ ../setup build
Preprocessing library dx9d3d-0.1...
Building dx9d3d-0.1...

DirectX9/D3D/Utility/Init.hs:4:26:
    parse error on input `loadCursor'

内容ぜんぜんわかってないんだけど、d3d/DirectX9/D3D/Utility/Init.hsのimport Graphics.Win32でエラーが出てる。Graphics.Win32なんてあったのか。関数や型をそれぞれ指定しているのをやめて一括でimportするようにしたらd3dも通った:

{- コメントアウト:
import Graphics.Win32   ( WindowClosure, HWND, mkClassName, loadIcon,
                        , loadCursor, createSolidBrush, rgb, registerClass
                        , showWindow, updateWindow, sendMessage, WPARAM
                        , LPARAM, LRESULT, WindowMessage, defWindowProc
                        , createWindow, getMessage, translateMessage
                        , dispatchMessage, allocaMessage )
import Graphics.Win32   ( iDI_APPLICATION, iDC_ARROW, cS_VREDRAW, cS_HREDRAW
                        , wS_OVERLAPPEDWINDOW, sW_SHOWNORMAL, wM_DESTROY
                        , wM_QUIT, wM_KEYDOWN, vK_ESCAPE )
-}
import Graphics.Win32
d3dxのビルド

これは素直に通る…とみせかけてwarningがモリモリ発生:

root@ADMIN ~/dx9/d3dx
$ ../setup build
Preprocessing library dx9d3dx-0.1...
Building dx9d3dx-0.1...
[1 of 6] Compiling DirectX9.D3D.X.Raw ( DirectX9/D3D/X/Raw.hs, dist\build/DirectX9/D3D/X/Raw.o )
[2 of 6] Compiling DirectX9.D3D.X.Import ( DirectX9/D3D/X/Import.hs, dist\build/DirectX9/D3D/X/Import.o )
[3 of 6] Compiling DirectX9.D3D.X.Constants ( dist\build/DirectX9/D3D/X/Constants.hs, dist\build/DirectX9/D3D/X/Constants.o )
[4 of 6] Compiling DirectX9.D3D.X.Misc ( DirectX9/D3D/X/Misc.hs, dist\build/DirectX9/D3D/X/Misc.o )

DirectX9/D3D/X/Misc.hs:9:43:
    Warning: Imported from `Foreign' but not used: `peekArray'
[5 of 6] Compiling DirectX9.D3D.X.Shader ( DirectX9/D3D/X/Shader.hs, dist\build/DirectX9/D3D/X/Shader.o )
[6 of 6] Compiling DirectX9.D3D.X   ( DirectX9/D3D/X.hs, dist\build/DirectX9/D3D/X.o )

cbits\d3dx_raw.c:2:1:  warning: "UNICODE" redefined

<command line>:4:1:
     warning: this is the location of the previous definition

In file included from cbits\d3dx_raw.c:13:0: 
../gen/d3dx_c.h: In function `c_ID3DXFont_PreloadTextW':

../gen/d3dx_c.h:213:0:
     warning: passing arg 2 of pointer to function from incompatible pointer type
../gen/d3dx_c.h: In function `c_ID3DXFileData_Lock':

../gen/d3dx_c.h:225:0:
     warning: passing arg 3 of pointer to function from incompatible pointer type
../gen/d3dx_c.h: In function `c_ID3DXKeyframedAnimationSet_RegisterAnimationSRTKeys':

../gen/d3dx_c.h:270:0:
     warning: passing arg 6 of pointer to function from incompatible pointer type

../gen/d3dx_c.h:270:0:
     warning: passing arg 7 of pointer to function from incompatible pointer type

../gen/d3dx_c.h:270:0:
     warning: passing arg 8 of pointer to function from incompatible pointer type
../gen/d3dx_c.h: In function `c_ID3DXPatchMesh_GetDeclaration':

../gen/d3dx_c.h:304:0:
     warning: passing arg 2 of pointer to function from incompatible pointer type
../gen/d3dx_c.h: In function `c_ID3DXTextureGutterHelper_ApplyGuttersFloat':

../gen/d3dx_c.h:466:0:
     warning: passing arg 3 of pointer to function makes integer from pointer without a cast

../gen/d3dx_c.h:466:0:
     warning: passing arg 4 of pointer to function makes integer from pointer without a cast

../gen/d3dx_c.h:466:0:
     warning: passing arg 5 of pointer to function makes integer from pointer without a cast
c:\MinGW\bin\ar.exe: creating dist\build\libHSdx9d3dx-0.1.a

でも通ってるぽい。

テストアプリの作成

ライブラリのインストールはできたけど、使い方のドキュメントとかサンプルとかがないもんだからどうしていいのかわからない。

まずはGraphics.Win32でウィンドウを作るところから:Programming Windows in Haskell - 取り急ぎブログですを参考にしつつ、今まで自分で実装してたDirectXのチュートリアル2:頂点のレンダリングをやってみた:

わーいHaskellからDirectXを動かして絵が描けたー。ドキュメントがなくても型宣言を見てなんとなくできてしまうのがHaskellのすごいところ。でもありそれに頼ってしまう悪いところでもあるかもしらん。

  • Comポインタが有効か(NULLじゃないか)の判定関数が用意されてない
  • peekMessageが値を返してくれないのでc_PeekMessageを呼び出すはめに
  • PeekMessageに渡すPM_REMOVEが未定義
  • D3DADAPTER_DEFAULTが未定義
  • CUSTOMVERTEXを頂点バッファにコピーするあたりとか、明らかにCよりメンドイ

ライブラリはBSDライセンスということなので、せっかくだからGithubにでもあげようかな。

2009-04-24

任意のStorableの領域を0クリアする

いちいちCの構造体に対して初期化したオブジェクトを用意するのがメンドイので、変数に型を渡すと0クリアされたその型が返るような関数を書きたい。いうなれば

zeroMemory D3DPRESENT_PARAMETERS

とすると0クリアされたD3DPRESENT_PARAMETERSが返ってくるような。でもHaskellで型を扱う関数とか書けるのかわからない…。あとStorableの型クラスにその型のサイズを取得するsizeOfメソッドがあるけど、これはそのクラスのオブジェクトに対して使えるのであってクラスに対してではないので、型だけでは解決できない。

あれこれ悩んでたらallocaのソースが同じようなことをやっていた。型からオブジェクトを作るのにどんな型にもマッチするundefinedを使うとはうますぎる…。

これを参考に次のような形に:

foreign import ccall "zeroMemory" f_zeroMemory :: Ptr () -> Int -> IO ()
zeroMemory :: (Storable a) => IO a
zeroMemory = doZeroMemory undefined
	where
		doZeroMemory :: (Storable a) => a -> IO a
		doZeroMemory dmyobj =
			alloca $ \pbuf -> do
				f_zeroMemory (castFrom dmyobj pbuf) $ sizeOf dmyobj
				peek pbuf
		castFrom :: (Storable a) => a -> Ptr a -> Ptr ()
		castFrom _ = castPtr

ここでunsafePerformIOを使ってIOをはずすかどうかは良心にかかっている。

HaskellからCに構造体を渡す

HaskellからDirectXを使う - imHoの続き:Direct3DCreate9の呼び出しまで終わったから、次はデバイスの作成:

    // Set up the structure used to create the D3DDevice
    D3DPRESENT_PARAMETERS d3dpp;
    ZeroMemory( &d3dpp, sizeof( d3dpp ) );
    d3dpp.Windowed = TRUE;
    d3dpp.SwapEffect = D3DSWAPEFFECT_DISCARD;
    d3dpp.BackBufferFormat = D3DFMT_UNKNOWN;

    // Create the D3DDevice
    if( FAILED( g_pD3D->CreateDevice( D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, hWnd,
                                      D3DCREATE_SOFTWARE_VERTEXPROCESSING,
                                      &d3dpp, &g_pd3dDevice ) ) )
        ....

CreateDeviceにはD3DPRESENT_PARAMETERS構造体を渡してやる必要がある。therning.org/ magnus » Blog Archive » Haskell and C—structsを参考に、Haskellのソースを.hsから.hscに変更してhsc2hsでCの情報を取り出すようにする。

Haskell側でD3DPRESENT_PARAMETERSに相当する構造体を定義:
data D3DPRESENT_PARAMETERS = D3DPRESENT_PARAMETERS {
	backBufferWidth			:: UINT,
	backBufferHeight		:: UINT,
	backBufferFormat		:: D3DFORMAT,
	backBufferCount			:: UINT,

	multiSampleType			:: D3DMULTISAMPLE_TYPE,
	multiSampleQuality		:: DWORD,

	swapEffect			:: D3DSWAPEFFECT,
	hDeviceWindow			:: HWND,
	windowed			:: BOOL,
	enableAutoDepthStencil		:: BOOL,
	autoDepthStencilFormat		:: D3DFORMAT,
	flags				:: DWORD,

	-- /* FullScreen_RefreshRateInHz must be zero for Windowed mode */
	fullScreen_RefreshRateInHz	:: UINT,
	presentationInterval		:: UINT
	}
Storableの型クラスにして、Haskell側からC側に受け渡すクラスメソッドpokeを実装:
instance Storable D3DPRESENT_PARAMETERS where
	sizeOf _ = (#size D3DPRESENT_PARAMETERS)
	alignment _ = #alignment D3DPRESENT_PARAMETERS
	peek _ = error "peek is not implemented"
	poke ptr (D3DPRESENT_PARAMETERS a b c d e f g h i j k l m n) = do
		(#poke D3DPRESENT_PARAMETERS, BackBufferWidth) ptr a
		(#poke D3DPRESENT_PARAMETERS, BackBufferHeight) ptr b
		(#poke D3DPRESENT_PARAMETERS, BackBufferFormat) ptr c
		(#poke D3DPRESENT_PARAMETERS, BackBufferCount) ptr d
		(#poke D3DPRESENT_PARAMETERS, MultiSampleType) ptr e
		(#poke D3DPRESENT_PARAMETERS, MultiSampleQuality) ptr f
		(#poke D3DPRESENT_PARAMETERS, SwapEffect) ptr g
		(#poke D3DPRESENT_PARAMETERS, hDeviceWindow) ptr h
		(#poke D3DPRESENT_PARAMETERS, Windowed) ptr i
		(#poke D3DPRESENT_PARAMETERS, EnableAutoDepthStencil) ptr j
		(#poke D3DPRESENT_PARAMETERS, AutoDepthStencilFormat) ptr k
		(#poke D3DPRESENT_PARAMETERS, Flags) ptr l
		(#poke D3DPRESENT_PARAMETERS, FullScreen_RefreshRateInHz) ptr m
		(#poke D3DPRESENT_PARAMETERS, PresentationInterval) ptr n
IDirect3D9::CreateDeviceに相当するFFIの定義
foreign import ccall "direct3DCreateDevice" f_direct3DCreateDevice :: Com -> UINT -> D3DDEVTYPE -> HWND -> DWORD -> Ptr (D3DPRESENT_PARAMETERS) -> Ptr (Com) -> IO HRESULT

ほとんどCの宣言どおり書ける。

FFIを呼び出すHaskell側の関数:
direct3DCreateDevice :: Com -> UINT -> D3DDEVTYPE -> HWND -> DWORD -> D3DPRESENT_PARAMETERS -> IO (HRESULT, Com)
direct3DCreateDevice pD3D adapter deviceType hFocusWindow behaviorFlags presentationParameters =
	alloca $ \ppReturnedDeviceInterface -> do
		with presentationParameters $ \pPresentationParameters -> do
			res <- f_direct3DCreateDevice pD3D adapter deviceType hFocusWindow behaviorFlags pPresentationParameters ppReturnedDeviceInterface
			if failed res
				then return (res, nullPtr)
				else do
					dev <- peek ppReturnedDeviceInterface
					return (res,dev)

先ほど宣言したFFIの関数を呼び出す。allocaしてD3DDevice受け取り用の領域確保、withでHaskellのデータ構造からCに受け渡す構造体へのポインタに変換。

呼び出されるC側の関数:
HRESULT direct3DCreateDevice(IDirect3D9* pD3D, UINT Adapter, D3DDEVTYPE DeviceType, HWND hFocusWindow, DWORD BehaviourFlags, D3DPRESENT_PARAMETERS* pPresentationParameteres, IDirect3DDevice9** ppReturnedDeviceInterface) {
	return pD3D->CreateDevice(Adapter, DeviceType, hFocusWindow, BehaviourFlags, pPresentationParameteres, ppReturnedDeviceInterface);
}

なんてことはない、ただつないでるだけ。

Haskellから実際に使用する:
foreign export ccall "hs_main" hs_main :: HWND -> IO ()
hs_main :: HWND -> IO ()
hs_main hWnd = do
	putStrLn "Hello, Haskell!"
	g_pD3D <- direct3DCreate9 d3D_SDK_VERSION
	putStr "D3D: ";	print g_pD3D
	if g_pD3D == nullPtr
		then print "Create D3D failed"
		else do
			let d3dpp = zeroD3DPRESENT_PARAMETERS { windowed = True, swapEffect = d3DSWAPEFFECT_DISCARD, backBufferFormat = d3DFMT_UNKNOWN }
			(hr, g_pd3dDevice) <- direct3DCreateDevice g_pD3D d3DADAPTER_DEFAULT d3DDEVTYPE_HAL hWnd d3DCREATE_SOFTWARE_VERTEXPROCESSING d3dpp
			putStr "D3DDevice: "; print g_pd3dDevice
			if g_pd3dDevice == nullPtr
				then print "Create D3DDevice failed"
				else do
					release g_pd3dDevice
			release g_pD3D
	putStrLn "Exit, Haskell!"
実行結果:
$ make run
./directx.exe
Hello, Haskell!
Direct3D: 32 -> 00258E60
D3D: 0x00258e60
D3DDevice: 0x00260660
release: 00260660
release: 00258E60
Exit, Haskell!

できてる…のか?

たった一つの関数、一つの構造体のやり取りでこのソースの量。死ぬる。なんとか自動化できないものか…。

2009-04-23

Makefileからcabalに移行

MonaoはいままでMakefileを手書きしてたんだけど(といっても ghc --make を呼び出すだけなので実質何もしてないのだが)、cabalに移行してみた。以前○トリスを作ったときに向こうの人がcabal化してくれたときの.cabalファイルを参考に。

ひとつ違うのは、MonaoはSDL用にCソースがあること。これは

c-sources:        entry.c

という定義を追加すればよい。本当はFFIで呼び出すMain.hsのスタブのヘッダMain_stub.hへの依存関係があるんだけどわからないのであきらめた。

ToDo
  • 実行ファイルが dist/build/monao/monao.exe にできるんだけどカレントに持ってこれないか?
  • データの書き方はこれでいいのか?
  • installしたらどうなるのか?
参考
name:             monao
version:          0.1

license:          BSD3
license-file:     LICENSE
author:           mokehehe
maintainer:       <mokehehe@gmail.com>

stability:        Stable
category:         Game
synopsis:         A 2-D clone of Super Nario bros.
description:      A simple clone of Super Nario bros using hsSDL.
                  .
                  Git repo available at <http://github.com/mokehehe/monao/tree/master>.
homepage:         http://mokehehe.blogspot.com/

build-depends:    base, SDL, SDL-mixer

build-type:       Simple
tested-with:      GHC==6.8.3

data-files:       README.txt, README.ja.txt
data-files:       data/stage0.map
data-files:       data/img/*.*
data-files:       data/snd/*.*

executable:       monao
main-is:          Main.hs


ghc-options:      -Wall -O
ghc-prof-options: -prof -auto-all

c-sources:        entry.c

HaskellからDirectXを使う

Googleで検索してもそれらしいパッケージがあるようには見えない。ので勉強がてら作ってみる。

おもむろにHaskellのコード:DirectX.hs

{-# LANGUAGE ForeignFunctionInterface #-}

module DirectX where

import Foreign
import Foreign.C.Types

type HWND = Ptr ()
type Com = Ptr ()

foreign import ccall "direct3DCreate9" direct3DCreate9 :: CInt -> IO Com
foreign import ccall "release" release :: Com -> IO ()

d3D_SDK_VERSION = 32
d3D9b_SDK_VERSION = 31

foreign export ccall "hs_main" hs_main :: HWND -> IO ()
hs_main :: HWND -> IO ()
hs_main hWnd = do
	putStrLn "Hello, Haskell!"
	g_pD3D <- direct3DCreate9 d3D_SDK_VERSION
	print g_pD3D
	release g_pD3D
	putStrLn "Good bye, Haskell!"

IDirect3Dのポインタは「type Com = Ptr()」としてみた。これをコンパイルしてオブジェクトファイルとスタブを作る:

$ ghc -c DirectX.hs

.oと、DirectX_stub.c, h が出力される。

でCのエントリファイル:entry.cpp

#include "HsFFI.h"
#ifdef __GLASGOW_HASKELL__
#include "DirectX_stub.h"
#endif

#include <windows.h>
#include <d3d9.h>
#include <stdio.h>

extern "C" {

#ifdef __GLASGOW_HASKELL__
extern void __stginit_DirectX ( void );
#endif

HsPtr direct3DCreate9(int ver) {
	LPDIRECT3D9 p = Direct3DCreate9(ver);
	return p;
}

void release(HsPtr arr) {
	IUnknown* ptr = (IUnknown*)arr;
	ptr->Release();
}

} // extern "C"

LRESULT WINAPI MsgProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam) {
	switch (msg) {
	case WM_DESTROY:
		PostQuitMessage(0);
		return 0;
	}
	return DefWindowProc( hWnd, msg, wParam, lParam );
}

int main(int argc, char *argv[]) {
	hs_init(&argc, &argv);
#ifdef __GLASGOW_HASKELL__
	hs_add_root(__stginit_DirectX);
#endif

	// Register the window class
	WNDCLASSEX wc = {
		sizeof( WNDCLASSEX ), CS_CLASSDC, MsgProc, 0L, 0L,
		GetModuleHandle( NULL ), NULL, NULL, NULL, NULL,
		"D3D Tutorial", NULL
	};
	RegisterClassEx(&wc);

	// Create the application's window
	HWND hWnd = CreateWindow( "D3D Tutorial", "D3D Tutorial 02: Vertices",
							  WS_OVERLAPPEDWINDOW, 100, 100, 300, 300,
							  NULL, NULL, wc.hInstance, NULL );

	hs_main(hWnd);

	UnregisterClass( "D3D Tutorial", wc.hInstance );
	hs_exit();

	return 0;
}

Haskellから呼び出される関数は direct3DCreate9 と release で、HsPtr をやりとりする。ウィンドウクラスの登録やウィンドウの作成はひとまずC側でやってしまってる。

DirectXのライブラリのパスをghcに教えつつ、これを一緒にリンクする。ghc から DirectXのライブラリをリンクできるようにするために、DirectX SDKのライブラリにある d3d9.lib を libd3d9.a という名前にコピーしてやってから:

$ ghc --make -ffi -o directx.exe -O -no-hs-main DirectX.hs entry.cpp -Ic:/dxsdk/Include -Lc:\dxsdk\lib\x86 -ld3d9
Linking directx.exe ...

できた。実行結果:

$ ./directx.exe
Hello, Haskell!
0x00258e60
Good bye, Haskell!

ひとまずDIRECT3D9オブジェクトを作るところまで動いた。

参考

2009-04-22

キーをうまく受け付けなくなる現象解決

キー入力をはてなダイアリーに変えると、タイトル画面からゲームには入れるんだけど、ゲーム中に'i'による左キーしか受け付けなくなるという現象があった。

unsafePerformIO使ってるからなのかとか結構悩んだんだけど、なんのことはなかった。peekByteOffで取り出す型がこの場合型推論からBoolと判定されてるので、SDLKeyで指定したオフセットから連続する4バイトの領域をBool値として取り出してしまうので、例えば左キーを押すと上も下も右も押された状態と判定されてしまって、結局キーを押しても動かないという状態になっていた。

これを修正するために、取り出す型をWord8と指定したら望みどおりになった:

getKeyState :: IO (SDLKey -> Bool)
getKeyState = alloca $ \nkp -> do
	kp <- sdlGetKeyState nkp
	let f = \k -> (/= 0) $ unsafePerformIO $ (peekByteOff kp $ fromIntegral $ Graphics.UI.SDL.Utilities.fromEnum k :: IO Word8)
	return f

2009-04-18

Real World Haskell読書会に参加

タイムインターメディアさんで行われたReal World Haskell読書会に参加しました。

範囲はまえがき1章 始めましょう2章 型と関数。翻訳進行中とのことで、ある程度しっかりした和訳文書を用意してくださっていたので追うのが楽チンだった。5時間でこれだけ進めたのはかなりハイペースだと思う。

感想としては、原文の文章が長めで説明がくどめ、入門書には向いてないなぁと感じた。特に再帰の説明あたりは辛かった…。

そして二次会。いろいろ楽しい話を聞くことができました。あとKS率の高さが異常だった。あと、遠方から参加されてる方が多数いて、みなさん勉強熱心だなぁと感じました。素晴らしい!

LispやSchemeのコミュニティでは、「なぜ世間の人はLisp・S式の良さがわからん、俺たちが伝道してやる!」という怨念めいたものを感じるんですが、この会はそういうことがなかった。nobsunの人柄というべきか、まったりした雰囲気だった。そういえばHaskellのコミュニティってないよな、と思った。「Haskellユーザのためのハブサイト」もないし…。

というわけで作ってみた:日本のHaskellユーザのためのハブサイト(嘘ですよ)

捕捉できた人:

SDL-mixerでBGMが鳴らない件に関する長いぐだぐだ

monaoでBGMが鳴らない

HaskellからSDL-mixerが使えるようになったのでmonaoで使おうとしたんだけど、SEは鳴るけどBGMが鳴らない。原因を探るためにどんどんソースを削っていったら、なんかわからんけどキー判定の部分をなくしたら鳴るようになった。

getKeyState :: IO [SDLKey]
getKeyState = alloca $ \numkeysPtr -> do
  keysPtr <- sdlGetKeyState numkeysPtr
  numkeys <- peek numkeysPtr
-- コメントアウト
--  (map Graphics.UI.SDL.Utilities.toEnum . map fromIntegral . findIndices (== 1)) `fmap` peekArray (fromIntegral numkeys) keysPtr
  return []

この部分は自分で書いたんじゃなくてどっかのソースをパクッてきたような気がする。どういう内容なんだっけ、とググッたらはてなダイアリーがひっかかった。以前読んだときはあまりよく内容わからなかったんだけどようやくわかった。上のやり方だとSDLの元ソース側(sdlGetKeyStateで返ってくる値)は配列で持っているのをわざわざリストに変換しているので、毎フレームリスト確保するからMOTTAINAIってことですね。変更した

getKeyState :: IO (SDLKey -> Bool)
getKeyState = alloca $ \nkp -> do
  kp <- sdlGetKeyState nkp
  let f k = unsafePerformIO $ peekByteOff kp $ fromIntegral $ fromEnum k
  return f

でも f のクロージャを作るけどリスト作るよりはいいし使い勝手もよさそう。でこちらに変更してみたらテストプログラムでBGMが鳴るようになった。

やっぱりmonaoでBGMが鳴らないし、キーが効かない

でmonaoのソースに持っていったらキーが効かなくなっただけならまだしも、相変わらずBGMも鳴らない。タイトル画面からゲームへは移れるのでキーは効いてるんだけどゲームに入ると左キーしか反応しない。

なんでかなーと考えてみたら、ゲーム中はキーの押した瞬間を調べるために前の状態(先のクロージャ)と今の状態を比較するんだけど、前の状態は sdlGetKeyState で取ってきたポインタを unsafePerformIO で無理やり取ってるだけだから、次のフレームになったら同じ場所が書き換えられてしまって内容が保持されてないからだと思った。これはSDLのすべてのキーの状態から必要なキーだけを数値に変換して取っておけば大丈夫だろう。

でもBGMが鳴らないのは解せない。テストでは鳴ったのに。

「超前衛的ゲームプログラミング方法論」じゃない単純なソースでBGMを鳴らす

monaoは超前衛的ゲームプログラミング方法論を使ってるけど、そうじゃないもっと単純なソースでBGMを鳴らしてみる。やっぱり鳴るよなぁと思ってたら、長い間放置するとあるところで途切れる。ここでハタと思いつく:BGMをloadMUSで読み込んでplayMusicで再生して投げっぱなしにしてるけどどこにも保存してないので、GCで回収されるときに停止してしまうんじゃないだろうか。

だから不定時にBGMが停止してたのか。これを防ぐには再生中のBGMをどっかに持っておく必要がある。

IORef

再生中のBGMみたいにグローバル的に扱いたい変数を、大域的に

playingBGM = newIORef Nothing

とかみたいな感じに書けて値を取り出したり変更したりできればいいんだけど、newIORefの型はa -> IO (IORef a)だから上のようには書いても値を保持するのには使えない。かといってmainから延々引きずり回すのは辛いし…てなことでunsafePerformIO

playingBGM :: IORef (Maybe Music)
playingBGM = unsafePerformIO $ newIORef Nothing

これを使って、再生時は

    music <- loadMUS "bgm.mp3"
    playMusic music (-1)
    writeIORef playingBGM $ Just music

停止時は

    m <- readIORef playingBGM
    case m of
      Nothing -> return ()
      Just mus -> do
        freeMusic mus
        writeIORef playingBGM Nothing

てな具合で鳴るようになった。

再生中のBGM、みたいなグローバルな状態を使いたい、けどunsafeを使うのはちょっと、なのでkazu-yamamotoさんのところをちゃんと読む:

2009-04-16

SDL-mixerを使う Windows編

SDL_mixer
  • SDL_mixerのページからBinary:のWin32のSDL_mixer-devel-1.2.8-VC8.zipをダウンロード
  • 中身のincludeとlibをコンパイル時に見えるところに置く (例:c:\cygwin\usr\local\include\SDL)、lib内のdllは実行パスの通ったところに置く
HaskellのSDL-mixer
  • HackageDB: SDL-mixerからダウンロード
  • 展開した中身のSDL-mixer.cabalにパスを書き足す
include-dirs:
	cbits, C:\cygwin\usr\local\include
extra-lib-dirs:
	C:\cygwin\usr\local\lib
  • ソースの修正:
    • Graphics/UI/SDL/Mixer/General.hsc と Version.hsc の先頭に #undef main を追加する
#include <SDL_mixer.h>
#ifdef main  // 追加
#undef main  // 追加
#endif       // 追加
...
  • configure, build, install
テストのビルド

昨日のテストプログラムをビルドしてみる:

$ ghc --make Main.hs
Linking Main.exe ...
C:\cygwin\usr\local\lib/libSDLmain.a(SDL_win32_main.o)(.text+0x417): In function
 `console_main':

/Users/hercules/trunk/SDL-1.2/./src/main/win32/SDL_win32_main.c:246:0:
     undefined reference to `SDL_main'
collect2: ld returned 1 exit status

SDL_mainがないといわれる。以前SDLでのときのように、Cでエントリ関数用のファイルを作ってやる:entry.c

#include "HsFFI.h"
#ifdef __GLASGOW_HASKELL__
#include "Main_stub.h"
#endif

#ifdef __GLASGOW_HASKELL__
extern void __stginit_Main ( void );
#endif

#include <SDL/SDL.h>

int main(int argc, char *argv[])
{
  hs_init(&argc, &argv);
#ifdef __GLASGOW_HASKELL__
  hs_add_root(__stginit_Main);
#endif

  start_hs();

  hs_exit();
  return 0;
}

.hsのmainをFFI用にする

{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign
...

foreign export ccall "start_hs" main :: IO ()
...

できた。.hsだけで済まないところがメンドイのう。