プログラミング / Haskell / HSDL

/HSDL

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.9とGHC 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"]

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

簡単なプログラム †

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からの移植 †

ほぼイベント周りの書き換えだけで，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

コメント †

お名前:

PukiWiki.
Skin "GS2" is designed by yiza.
Powered by PHP 5.1.4. HTML convert time: 0.362 sec.