tanakhさんの開発したSDLをHaskellから使う為のラッパHSDLを使ってみます.
HSDLを使うと,プラットフォームに依存するコードを含めずに
ウィンドウ,3D,オーディオ,ジョイスティック等を扱う事ができます.

SDLの好きな所

Haskellで様々なプラットフォームで動く,OpenGLを使ったアプリケーションを作る場合
最初に思いつくのはGLUTを使う事ですが,SDLはGLUTと比べて

  • 音が扱える
    SDLでは音を再生する為の機能が提供されています.
  • モディファイキーの扱い
    CtrlキーやAltを他のキーと同等に扱う事もできる所.
  • ジョイスティック周りのイベントが豊富
    GLUTでもジョイスティックの入力を処理できますが,簡易的な物だけです.
  • イベントの処理が私好み
    (Gtkっぽい)コールバックを待つGLUTよりも,イベントを拾いに行くSDLの方がWindowsSDKに近くて私好みです. 等の点で気に入りました.

さらに,SDLとGLUTを組み合わせて使う事も簡単に出来ます.

インストール

Windows+GHCの環境にHSDLをインストールしてみます.
HSDLはtanakhさんのウェブサイトからDLできます.
この記事を書いている時点での最新バージョンは0.2.0ですが
これのインストールには,SDL1.2.9GHC 6.4が必要です.
GHC 6.4.1や6.4.2では

Files\hsdl\hsdl-0.2.0/HShsdl-0.2.0.o...C:\Program Files\hsdl\hsdl-0.2.0/libHShsdl-0.2.0.a(Audio_stub.o)(.text+0x0):Audio_stub.c
: multiple definition of `MultimediaziSDLziAudio_dAat'
C:\Program Files\hsdl\hsdl-0.2.0/libHShsdl-0.2.0.a(Audio_stub.o)(.text+0x0):Audi
o_stub.c: first defined here
C:\Program Files\hsdl\hsdl-0.2.0/libHShsdl-0.2.0.a(Event_stub.o)(.text+0x0):Even
t_stub.c: multiple definition of `MultimediaziSDLziEvent_dvBb'
C:\Program Files\hsdl\hsdl-0.2.0/libHShsdl-0.2.0.a(Event_stub.o)(.text+0x0):Even
t_stub.c: first defined here
.....他沢山

等とエラーが出てうまくインストールできなかったので注意が必要です.

HSDLをインストールする前に,SDL1.2.9のDevelopment Librariesを用意しないといけませんが,
CからSDLを使うつもりが無ければ,適当なフォルダにlibとincludeの中身をコピーしておき
後はHSDLのREADME通りHSDL.cabalを

include-dirs:
	D:\ghc\ghc-6.4\sdl\include
ld-options:
	-LD:\ghc\ghc-6.4\sdl\lib

のようにすれば問題なくインストールできました.
SDLのDevelopment Librariesを用意していないと

D:\HaskellProjects\HSDL-0.2.0>runghc Setup.hs build Preprocessing library hsdl-0.2.0...
Building hsdl-0.2.0...
Chasing modules from: Multimedia.SDL,Multimedia.SDL.Audio,Multimedia.SDL.Event,Multimedia.SDL.Init,Multimedia.SDL.Joystick,Multimedia.SDL.Keysym,Multimedia.SDL.
Timer,Multimedia.SDL.Util,Multimedia.SDL.Video,Multimedia.SDL.Window
Skipping  Multimedia.SDL.Util ( ./Multimedia/SDL/Util.hs, dist\build\./Multimedia/SDL/Util.o )
Compiling Multimedia.SDL.Video ( ./Multimedia/SDL/Video.hs, dist\build\./Multime
dia/SDL/Video.o )
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:5:17: SDL.h: No such file or directory
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:6:17: SDL.h: No such file or directory
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc: In function `MultimediaziSDLziVideo_zdwccall_entry':
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:8209: warning: implicit declaration of function `SDL_GL_SwapBuffers'
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc: In function `MultimediaziSDLziVideo_zdwccall1_entry':
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:8335: warning: implicit declaration of function `SDL_GL_SetAttribute'
...............続く
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc: In function `MultimediaziSDLziVideo_zdwccall42_entry':
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:13083: warning: implicit declaration of function `SDL_GetVideoSurface'
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc: In function `MultimediaziSDLziVideo_zdwccall43_entry':
C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ghc3368.hc:13124: warning: implicit declaration of function `SDL_RWFromFile'

D:\HaskellProjects\HSDL-0.2.0>runghc Setup.hs install
Installing: C:\Program Files\hsdl\hsdl-0.2.0 & C:\Program Files\hsdl\bin hsdl-0.2.0...
Error: Could not find module: Multimedia.SDL with any suffix: ["hi"]

のようなエラーが出て失敗します.

簡単なプログラム

teapot.png

SDLを使ってウィンドウを作り,ティーポットを表示してみます.

ソースコード

import Multimedia.SDL
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU
import Graphics.Rendering.OpenGL as GL
import Control.Concurrent    --threadDelay

main = do
    initApp
    loop
    exitApp

exitApp = sdlQuit

initApp = do
    True <- sdlInit [VIDEO]

    glSetAttribute GL_RED_SIZE   5
    glSetAttribute GL_GREEN_SIZE 5
    glSetAttribute GL_BLUE_SIZE  5
    glSetAttribute GL_DEPTH_SIZE 16
    glSetAttribute GL_DOUBLEBUFFER 1

    setCaption "OpenGL" ""
    sur <- setVideoMode 640 480 16 [OPENGL]
    reshape 640 480

loop = do
    quit <- checkEvent
    display
    threadDelay 10
    if quit then return () else loop
    
checkEvent = do
    ev <- pollEvent
    case ev of
        Just QuitEvent -> return True
        Nothing        -> return False
        _              -> checkEvent

reshape w h=do
    viewport $= (Position 0 0, GL.Size w h) --ウィンドウ全体を使う
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    matrixMode $= Modelview 0
    lookAt (Vertex3 0 0 1) (Vertex3 0 0 0) (Vector3 0 1 0)

display = do
    clear [ColorBuffer]
    
    preservingMatrix $ do
        renderObject Wireframe (Teapot 0.2)
    glSwapBuffers

説明

このプログラムでは

  • SDL
    • ウィンドウを作る
    • イベントの処理
  • OpenGL
    • レンダリング
  • GLUT
    • ティーポットを作る

のように,様々なライブラリで役割を分担しています.
SDLでガチガチに固めたプログラムを書く必要が無いのは,とても助かります.

キー入力を受ける

先ほどのプログラムを,何かキーを押した時に終了するようにしましょう.

ソース

import Multimedia.SDL
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU
import Graphics.Rendering.OpenGL as GL
import Control.Concurrent    --threadDelay

main = do
    initApp
    loop
    exitApp

exitApp = sdlQuit

initApp = do
    True <- sdlInit [VIDEO]

    glSetAttribute GL_RED_SIZE   5
    glSetAttribute GL_GREEN_SIZE 5
    glSetAttribute GL_BLUE_SIZE  5
    glSetAttribute GL_DEPTH_SIZE 16
    glSetAttribute GL_DOUBLEBUFFER 1

    setCaption "OpenGL" ""
    sur <- setVideoMode 640 480 16 [OPENGL]
    reshape 640 480

loop = do
    quit <- checkEvent
    display
    threadDelay 10
    if quit then return () else loop
    
checkEvent = do
    ev <- pollEvent
    case ev of
        Just QuitEvent -> return True
        Just KeyboardEvent{kbPress=True}-> return True
        Nothing        -> return False
        _              -> checkEvent

reshape w h=do
    viewport $= (Position 0 0, GL.Size w h) --ウィンドウ全体を使う
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    matrixMode $= Modelview 0
    lookAt (Vertex3 0 0 1) (Vertex3 0 0 0) (Vector3 0 1 0)

display = do
    clear [ColorBuffer]
    
    preservingMatrix $ do
        renderObject Wireframe (Teapot 0.3)
    glSwapBuffers

説明

前回のプログラムのcheckEvent関数に

Just KeyboardEvent{kbPress=True}-> return True

を追加しただけです.(checkEventがTrueになる時終了するようにloop関数がなっています)
KeyboardEventのkbKeysymを調べれば,キーの種類で判別する事もできます.

GLUTからの移植

space.png

ほぼイベント周りの書き換えだけで,GLUTで書いていたプログラムを移植する事もできました.

ソース

module Main where

import Multimedia.SDL hiding(color)
import Graphics.UI.GLUT hiding(position)
import Graphics.Rendering.OpenGL.GLU as GLU
import Graphics.Rendering.OpenGL as GL hiding(position)

import System
import System.Random
import Data.IORef
import Control.Monad
import Control.Concurrent    --threadDelay

type Unit = Double
type Point3 = Vertex3 Unit

data GameObject =
        Fire{position::Point3, velocity::Point3, temperature::Unit}
    |    Star{position::Point3}
    |    Bullet{position::Point3, velocity::Point3, life::Unit}
    |    Player{position::Point3, velocity::Point3, rotation::Unit, bullets::[GameObject]}
    
data GameState = Game{
    player::GameObject,
    objects::[GameObject],
    keys::[SDLKey]}
setGameKeys k game= Game{
    player=player game,
    objects=objects game,
    keys=k:(keys game)}
putGameKeys k game= Game{
    player=player game,
    objects=objects game,
    keys=filter (/=k) (keys game)}


data GameRenderer=Renderer{rendererFunc::DisplayCallback, game::IORef GameState}

addVer3::Num a => Vertex3 a->Vertex3 a->Vertex3 a
addVer3 (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2)
            = Vertex3 (x1+x2) (y1+y2) (z1+z2)
subVer3::Num a => Vertex3 a->Vertex3 a->Vertex3 a
subVer3 (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2)
            = Vertex3 (x1-x2) (y1-y2) (z1-z2)
multVer3::Num a=>Vertex3 a->a->Vertex3 a
multVer3 (Vertex3 x y z) n
    = Vertex3 (x*n) (y*n) (z*n)
            
updateObject::GameObject->GameObject
updateObject Bullet{position=pos, velocity=vel, life=l}
    =Bullet{
        position = addVer3 pos vel,
        velocity = vel,
        life     =l-1}

updateObject Fire{position=pos, velocity=vel, temperature=temp}
    =Fire{
        position = addVer3 pos vel,
        velocity = vel,
        temperature=temp-1}
updateObject o = o

checkDelete Fire{temperature=temp} = temp < 0
checkDelete Bullet{life=l} = l < 0
checkDelete _ =False

updateObjects::[GameObject]->[GameObject]
updateObjects [] = []
updateObjects (o:os) = if checkDelete o 
    then updateObjects os
    else (updateObject o):(updateObjects os)
    where
        getY (Vertex3 _ y _) = y

backGroundSize=3.0
getBackgroundStars::Unit->Unit->Int->[GameObject]
getBackgroundStars x y num= getStars (sep x) (sep y)
    where
        getStars x' y'=
            (take (num`div`4) $ getStarsPeace (x'  ) (y'  ))
            ++ (take (num`div`4) $ getStarsPeace (x'-1) (y'  ))
            ++ (take (num`div`4) $ getStarsPeace (x'  ) (y'-1))
            ++ (take (num`div`4) $ getStarsPeace (x'-1) (y'-1))
        getStarsPeace x' y'= map (newStar x' y') $ (zipXY $ (getRnds x' y'))
        size=backGroundSize
        getRnds x' y'= randomRs (0,size) (mkStdGen $ x'+(y'*32767))
        zipXY xs@(x:ys) = zip xs ys
        newStar sx sy (nx,ny) = Star{position=addVer3 (sepver sx sy) (Vertex3 nx ny 0)}
        sep n' = round $ n' / size --何番目の背景を表示するべきか
        sepver x' y'= Vertex3 (size*(fromIntegral x')) (size*(fromIntegral y')) 0
    
tempAve=40
newFire::Point3->Point3->IO GameObject
newFire p v=do
    newVel <- getRandomVel
    newTemp<- getRandomTemp
    return Fire{
        position=p,
        velocity=addVer3 v newVel,
        temperature=newTemp}
    where
        getRandomTemp=do
            g <- newStdGen
            (t,g') <- return $ randomR (tempAve-10, tempAve) g
            return t
        getRandomVel=do
            gx <- newStdGen
            (x,gy) <- return $ randomR ( -expl, expl) gx
            (y,gz) <- return $ randomR ( -expl, expl) gy
            (z,g') <- return $ randomR ( -expl, expl) gz
            return $ Vertex3 x y z
        expl=0.01

--個数 場所 方向
newFires::Int->Point3->Point3->IO [GameObject]
newFires 0 _ _ = return []
newFires n p v= do
    new <- newFire p v
    ps<- newFires (n-1) p v
    return (new:ps)

main = do
    initApp
    
    --Gameを作る
    gameState <- newIORef Game{
        player=Player{position=Vertex3 0 0 0, velocity=Vertex3 0 0 0, rotation=0, bullets=[]},
        objects=[],
        keys=[]}
    gameRenderer <- newIORef Renderer{
        rendererFunc=display gameState, game=gameState}
    reshape gameState $ GL.Size 640 480
    loop gameRenderer
    exitApp

exitApp = sdlQuit

initApp= do
    True <- sdlInit [VIDEO]

    glSetAttribute GL_RED_SIZE   5
    glSetAttribute GL_GREEN_SIZE 5
    glSetAttribute GL_BLUE_SIZE  5
    glSetAttribute GL_DEPTH_SIZE 16
    glSetAttribute GL_DOUBLEBUFFER 1

    setCaption "Space" ""
    setVideoMode 640 480 16 [OPENGL]
    
display gameState= do
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    gs    <- readIORef gameState
    ply    <- return $ player gs
    
    setCenter gs
    
    pointSize $=4.0
    --表示
    Player{position=Vertex3 px py _, velocity=_}<-return ply
    ----グリッドの表示--------------------------------
    --color (Color3 1.0 1.0 1.0 :: Color3 Unit)
    --preservingMatrix $ renderPrimitive Lines $ do mapM_ vertex (gridLines px py)
    --------------------------------------------------
    (Vertex3 x y _)<-return $ position ply
    showObjects $ 
        ply:(objects gs)
        ++bullets ply
        ++getBackgroundStars x y 48
    
    --バッファの入れ替え
    glSwapBuffers
    
    where
        fireAlpha=0.8
        fireSize =0.03
        bulletSize = 0.005
        gridLines px py=[
                Vertex3 ((gridX+1)*backGroundSize) (gridY*backGroundSize) 0,
                Vertex3 ((gridX-1)*backGroundSize) (gridY*backGroundSize) 0,
                Vertex3 (gridX*backGroundSize) ((gridY+1)*backGroundSize) 0,
                Vertex3 (gridX*backGroundSize) ((gridY-1)*backGroundSize) 0
                
            ]
            where
                gridX = fromInteger $ round $ px/backGroundSize
                gridY = fromInteger $ round $ py/backGroundSize
        tempToColor4 t a = Color4 (1.0-0.02*(tempAve-t)) (1.0-0.04*(tempAve-t)) (1.0-0.08*(tempAve-t)) a
        getSprite w=[
            Vertex3 (-w) (-w) 0,
            Vertex3 (-w)   w  0,
            Vertex3   w  (-w) 0,
            Vertex3   w  (-w) 0,
            Vertex3 (-w)   w  0,
            Vertex3   w    w  0]
        showObjects [] = return ()
        showObjects (o:os) = showObject o >> showObjects os
        
        showObject Star{position=pos} = do
            color (Color3 1.0 1.0 1.0 :: Color3 Unit)
            preservingMatrix $ renderPrimitive Triangles $ do
                mapM_ vertex $ map (addVer3 pos) $ getSprite 0.01
        
        showObject Fire{position=pos, temperature=temp} = do
            blend$=Enabled
            blendFunc $= (SrcAlpha, OneMinusSrcColor)
            color (tempToColor4 temp fireAlpha)
            preservingMatrix $ renderPrimitive Triangles $ do
                mapM_ vertex $ map (addVer3 pos) $ getSprite fireSize
            blend$=Disabled
        
        showObject Bullet{position=pos} = do
            color (Color3 1 1 0::Color3 Unit)
            preservingMatrix $ renderPrimitive Triangles $ do
                mapM_ vertex $ map (addVer3 pos) $ getSprite bulletSize
                
        showObject Player{position=Vertex3 x y z, rotation=rot} = do
            color (Color3 0.8 0.8 0.8 :: Color3 Unit)
            lineWidth $= 3.0
            preservingMatrix $ do
                translate (Vector3 x y z)
                scale (0.001::Double) 0.001 0.001
                rotate (180*rot/pi) (Vector3 0 0 1::Vector3 Unit)
                translate (Vector3 (-40::Unit) (-50) 0)
                renderString Roman "A"
            --preservingMatrix $ do
            --    translate (Vector3 x y z)
            --    renderObject Wireframe (Sphere' 0.05 5 5)--(Teapot 0.06)

modifyGame::IORef GameState->IO()
modifyGame game = do
    gs <- readIORef game
    ks <- return $ keys gs
    --プレイヤーを動かす
    ply  <- return $ player gs
    ppos <- return $ position ply 
    pvel <- return $ velocity ply
    rot  <- return $ keyRotate ks + (rotation ply)
    --上キーが押されていたら加速
    addVec <- if elem SDLK_UP ks
        then return $ getRotVer3 rot acceleration
        else return $ Vertex3 0 0 0
    
    --プレイヤーの速度を更新
    newVel <- return $ addVer3 pvel addVec
    
    --プレイヤーの座標を更新
    newPos <- return $ addVer3 ppos newVel
    
    --下キーか左Ctrlが押されていたら弾を発射
    newBullet <-
        if or [elem SDLK_DOWN ks, elem SDLK_LCTRL ks]
            then return [Bullet{
                position=addVer3 (getRotVer3 rot 0.06) newPos,
                velocity=addVer3 newVel $ getRotVer3 rot 0.08,    --弾の速度
                life = 100}]
            else return []
        
    --プレイヤーが動くならパーティクルを吐く
    ps <-if addVec==Vertex3 0 0 0
        then return [] 
        else newFires 4                                    --火の玉を追加
            (addVer3 (getRotVer3 rot (-0.06)) newPos)    --ずらす量
            (addVer3 pvel $ multVer3 addVec (-3))        --発射速度
    newPlayer <- return Player{
        position=newPos,
        velocity=newVel,
        rotation=rot,
        bullets=newBullet++(updateObjects $ bullets ply)
    }
    
    writeIORef game 
        Game{
            player    =newPlayer,
            objects    =ps++(updateObjects$objects gs),
            keys    =keys gs}
    where
        acceleration = 0.003
        getRotVer3 r l= multVer3 (Vertex3 (sin (-r)) (cos (-r)) 0) l
        keyRotate keySet
            | elem SDLK_LEFT  keySet =  0.1 
            | elem SDLK_RIGHT keySet = -0.1
            | otherwise = 0

loop::IORef GameRenderer->IO ()
loop grRef = do
    gr <- readIORef grRef
    quit <- checkEvent $game gr
    modifyGame $ game gr
    gs <- readIORef $ game gr
    rendererFunc gr
    threadDelay 8000
    if quit then return () else loop grRef
    
checkEvent::IORef GameState->IO Bool
checkEvent gameRef= do
    gs   <- readIORef gameRef
    keySet <- return $ keys gs
    ev <- pollEvent
    case ev of
        Just QuitEvent -> return True
        Just kev@(KeyboardEvent{})->keyEvent gs kev
        Nothing        -> return False
        _              -> checkEvent gameRef
    where
        keyEvent gs kev@(KeyboardEvent{kbPress=press, kbKeysym = Keysym{ksSym=ks}})
            | press     = case ks of
                SDLK_ESCAPE-> return True
                otherwise  -> modifyIORef gameRef (setGameKeys ks) >> checkEvent gameRef
            | otherwise = modifyIORef gameRef (putGameKeys ks) >> checkEvent gameRef

setCenter gs = do
    Vertex3 x y z <- return $ position$player gs
    --lookAt (Vertex3 0.0 0.0 (1.0)) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
    lookAt (Vertex3 x y (2.0)) (Vertex3 x y 0.0) (Vector3 0.0 1.0 0.0::Vector3 Unit)

--ウィンドウのサイズが変更された時の処理
reshape::IORef GameState->GL.Size->IO ()
reshape gameState size@(GL.Size w h)=do
    viewport $= (Position 0 0, size) --ウィンドウ全体を使う
    gs <- readIORef gameState
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    --少し後ろから撮影
    matrixMode $= Modelview 0
      setCenter gs

コメント


お名前:
添付ファイル: filespace.png 1373件 [詳細] fileteapot.png 1286件 [詳細]