プログラミング/Haskell/GLUT

GLUTを使うと，様々なプラットフォーム上で動作するOpenGLのアプリケーションが簡単に書けます．
GHCには標準でこのライブラリが含まれるので，色々試してみようと思います．

GLUTのインストール †

GLUTを使ったプログラムの実行には，GLUTのライブラリが必要です．
インターネット上にたくさん情報があるので調べてください．
for WIN32

$=演算子 †

GLUTのコールバック関数の登録等には，$=演算子を使います．

$=演算子はHasSetterクラスのメソッドで，実際には StateVar型に対してよく使う気がします．この型はStateモナドと同じような物で，状態を持つ為に使います．

$=演算子はStateVar型の状態を更新する為に使います．
例えば

clearColor $= Color4 0.0 0.0 0.0 0.0

とすると，clear関数でColorBufferをクリアする時に「Color4 0.0 0.0 0.0 0.0」でクリアされる事になります．
http://www.haskell.org/ghc/docs/latest/html/libraries/OpenGL/Graphics-Rendering-OpenGL-GL-Framebuffer.html#v%3Aclear

C言語が分かる方なら
GLUTの設定を保持する為の，StateVar型のグローバル変数(clearColor等)があってその変数に値を代入する為に，$=演算子を使う．
と思っておいて，問題は無いと思います．
(色々なHaskellの偉い方に怒られそうですが^^;

↑

四角形をぐるぐる回す †

四角形がぐるぐる回るサンプルプログラムです．

GLUTの初期化
変数(的な物)を扱って角度を格納

を試してみました．

import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU

import Data.IORef

--タイマの間隔
timerInterval = 40

main = do
    --回転の角度を初期化
    rot <- newIORef 0.0
    
    --GLUTの初期化
    initialDisplayMode $= [RGBAMode, DoubleBuffered]
    initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "guruGuru"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display rot
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just reshape
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc (display rot)
    
    --GLUTのメインループに入る
    mainLoop

display rot = do
    --回転させる
    modifyIORef rot (+14.4)
    r <- readIORef rot
    
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    --表示
    preservingMatrix $ do
        rotate r (Vector3 0.0 0.0 1.0 :: Vector3 GLdouble)
        renderPrimitive Quads $ mapM_ vertex [
                    Vertex3 0.10 0.10 0.0,
                    Vertex3 (-0.10) 0.10 0.0,
            Vertex3 (-0.10) (-0.10) 0.0,
            Vertex3 0.10 (-0.10) 0.0 :: Vertex3 GLfloat]
    
    --バッファの入れ替え
    swapBuffers

--タイマが呼ばれるたびにactを繰り返す
timerProc act = do
    act
    addTimerCallback timerInterval $ timerProc act
    
--ウィンドウのサイズが変更された時の処理
reshape size@(Size w h)=do
    viewport $= (Position 0 0, size) --ウィンドウ全体を使う
    
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    --少し後ろから撮影
    lookAt (Vertex3 0.0 0.0 (-1.0)) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
    matrixMode $= Modelview 0

main.hs等のファイル名で保存して

ghc -package GLUT main.hs

としてやれば実行ファイルができます．

↑

解説 †

回転の角度を格納するのに，今回はIORefモナドを使う事にしました．
モナドと聞くと難しいイメージがありますが，道具として簡単に使うだけなら
詳細な理論等は気にしないでOKです．これを使う為に

import Data.IORef

としてモジュールを読み込みます．
このIORefを使うと，C++で言う所の参照を扱う事ができます．例えば

ref <- newIORef 1

とすると，refには1を持つ変数への参照を返します．C++での

ref = new int(1);

に似ていますね．
refは参照なので，そのままでは整数として扱えません．

r <- readIORef ref

のようにすると，整数を取り出す事ができます．
このIORefには他にもwriteIORefやmodifyIORef等の関数が使えます．使い方はソースコードを読めば分かると思います．

↑

キーボードからの入力を受ける †

キーボードの動きに応じて動作を変える事ができれば，時間とやる気しだいで何でも作れますね(本当かな？^^;)．
先ほどのプログラムに少しコードを書き足して，キーボードの入力で回転の方向が変わるようにしてみます．

↑

コード †

import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU

import System
import Data.IORef

--タイマの間隔
timerInterval = 40

main = do
    --回転の角度を初期化
    rot <- newIORef 0.0
    arg <- newIORef 14.4
    
    --GLUTの初期化
    initialDisplayMode $= [RGBAMode, DoubleBuffered]
    initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "guruGuru"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display rot arg
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just reshape
    
    --キーボードやマウスのコールバック
    keyboardMouseCallback $= Just (keyboardProc arg)
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc (display rot arg)
    
    --GLUTのメインループに入る
    mainLoop

display rot arg= do
    --回転させる
    w<-readIORef arg 
    --w <- readIORef hoge
    modifyIORef rot (+w)
    r <- readIORef rot
    
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    --表示
    preservingMatrix $ do
        rotate r (Vector3 0.0 0.0 1.0 :: Vector3 GLdouble)
        renderPrimitive Quads $ mapM_ vertex [
                    Vertex3 0.10 0.10 0.0,
                    Vertex3 (-0.10) 0.10 0.0,
            Vertex3 (-0.10) (-0.10) 0.0,
            Vertex3 0.10 (-0.10) 0.0 :: Vertex3 GLfloat]
    
    --バッファの入れ替え
    swapBuffers

--タイマが呼ばれるたびにactを繰り返す
timerProc act = do
    act
    addTimerCallback timerInterval $ timerProc act
    
--ウィンドウのサイズが変更された時の処理
reshape size@(Size w h)=do
    viewport $= (Position 0 0, size) --ウィンドウ全体を使う
    
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    --少し後ろから撮影
    lookAt (Vertex3 0.0 0.0 (-1.0)) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
    matrixMode $= Modelview 0
    
--キー入力の処理
keyboardProc arg ch state _ _
    | ch     == Char 'q'    = exitWith ExitSuccess        --qが押されたら終了
    | state    == Down        = modifyIORef arg (*(-1))    --それ以外なら回転の方向を変える
    | otherwise            = return ()

こんな感じです．先ほどと同じく

ghc -package GLUT main.hs

とすればコンパイルできます．

↑

変更点 †

keyboardMouseCallback $= Just (keyboardProc arg)

これでキーボードやマウスにイベントが起こった時に呼ばれるコールバック関数を指定します．
argは一度に回転させる角度を格納した変数への参照です．

keyboardProc arg ch state _ _
	| ch 	== Char 'q'	= exitWith ExitSuccess		--qが押されたら終了
	| state	== Down		= modifyIORef arg (*(-1))	--それ以外なら回転の方向を変える
	| otherwise			= return ()

このkeyboardProcがキーを押した時に呼ばれます．詳しい説明はこちらを読んでください．
chはキーの種類，stateに押したのか離したのかが格納されています．
ガード部で，qが押された時に終了，それ以外のキーが押された時に回転方向を反転するようにしました．

↑

パーティクル †

Haskellで乱数を扱ってみます．
左の点からランダムにパーティクルが飛びだします．モナドの扱いにまだ慣れていないせいか，型チェックに引っかかって，なかなかコンパイルが通りませんでした^^;

↑

ソース †

module Main where

import Graphics.UI.GLUT hiding (position)
import Graphics.Rendering.OpenGL.GLU

import System
import System.Random
import Data.IORef

--タイマの間隔
timerInterval = 16

type Point= Vertex3 GLdouble
data GameObject = Particle{position::Point, velocity::Point}
data GameState = Game{objects::[GameObject]}
data GameRenderer=Renderer{rendererFunc::DisplayCallback, game::IORef GameState}

updateObject::GameObject->GameObject
updateObject Particle{position=pos, velocity=vel}
    =Particle{
        position = addVer3 pos vel,
        velocity = addVer3 vel (Vertex3 0.0 (-0.001) 0.0) }
    where
        addVer3 (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2)
            = Vertex3 (x1+x2) (y1+y2) (z1+z2)
            
updateObjects::[GameObject]->[GameObject]
updateObjects os
    = filter (\o-> getY (position o) >(-0.5))    --ある程度落ちた点は消す
        $ map updateObject os                    --座標を更新する
    where
        getY (Vertex3 _ y _) = y
        
newParticle::IO GameObject
newParticle=do
    newVel <- getRandomVel
    return Particle{
        position=Vertex3 0 0 0,
        velocity=newVel}
    where
        getRandomVel::IO Point
        getRandomVel=do
            gx <- newStdGen
            (x,gy) <- return $ randomR ( 0.01, 0.02) gx
            (y,gz) <- return $ randomR ( 0.01, 0.03) gy
            (z,g') <- return (0.0, gz) -- $ randomR (-0.02, 0.02) gz
            return $ Vertex3 x y z

newParticles::Int->IO [GameObject]
newParticles 0 = return []
newParticles n = do
    p <- newParticle
    ps<- newParticles $ n-1 
    return $ p:ps
    
main = do
    --Gameを作る
    p <- newParticle
    gameState <- newIORef Game{objects=[p]}
    gameRenderer <- newIORef Renderer{
        rendererFunc=display gameState, game=gameState}
    --GLUTの初期化
        initialDisplayMode $= [RGBAMode, DoubleBuffered]
        initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "Particle"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display gameState-- gameState
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just reshape
    
    --キーボードやマウスのコールバック
    keyboardMouseCallback $= Just (keyboardProc)
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc gameRenderer
    
    --GLUTのメインループに入る
    mainLoop

display gameState= do
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    gs <- readIORef gameState
    pointSize $=4.0
    --表示
    preservingMatrix $ do
        renderPrimitive Points $ mapM_
            vertex$ map position (objects gs)
    --バッファの入れ替え
    swapBuffers

--タイマが呼ばれるたびにactを繰り返す
timerProc::IORef GameRenderer->IO ()
timerProc grRef = do
    gr <- readIORef grRef
    gs <- readIORef $ game gr
    rendererFunc gr
    ps <-newParticles 32
    writeIORef (game gr)
        Game{
            objects=ps++(updateObjects$objects gs)}
    addTimerCallback timerInterval $ timerProc grRef
    
--ウィンドウのサイズが変更された時の処理
reshape size@(Size w h)=do
    viewport $= (Position 0 0, size) --ウィンドウ全体を使う
    
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    --少し後ろから撮影
    lookAt (Vertex3 0.5 0.2 (1.0)) (Vertex3 0.5 0.2 0.0) (Vector3 0.0 1.0 0.0)
    matrixMode $= Modelview 0
    
--キー入力の処理
keyboardProc ch state _ _
    | ch     == Char 'q'    = exitWith ExitSuccess        --qが押されたら終了
--    | state    == Down        = modifyIORef arg (*(-1))    --それ以外なら回転の方向を変える
    | otherwise            = return ()

↑

解説 †

GLUT的な変更点はありません．
指定した範囲の乱数を取得する関数randomRを使ってみました．
使い方はここが参考になると思います．

↑

彗星 †

矢印キーで，パーティクルを飛ばしながら飛行する物体を操作できます．

↑

ソース †

今回もHaskell的で無いです．

module Main where

import Graphics.UI.GLUT hiding (position)
import Graphics.Rendering.OpenGL.GLU

import System
import System.Random
import Data.IORef
import Control.Monad
import qualified Data.Set as Set
import qualified Data.Map as Map

--タイマの間隔
timerInterval = 16

type Point= Vertex3 GLdouble

data GameObject =
        Particle{position::Point, velocity::Point}
    |    Player{position::Point, velocity::Point}

data GameState = Game{
    player::GameObject,
    objects::[GameObject],
    keys::IORef (Set.Set Key)}
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)
            
updateObject::GameObject->GameObject
updateObject Particle{position=pos, velocity=vel}
    =Particle{
        position = addVer3 pos vel,
        velocity = vel}-- 重力ON addVer3 vel (Vertex3 0.0 (-0.001) 0.0) }

            
updateObjects::[GameObject]->[GameObject]
updateObjects os
    = map updateObject os 
    -- filter (\o-> getY (position o) >(-0.5))    --ある程度落ちた点は消す
    -- $ map updateObject os                    --座標を更新する
    where
        getY (Vertex3 _ y _) = y
    
newParticle::Point->Point->IO GameObject
newParticle p v=do
    newVel <- getRandomVel
    return Particle{
        position=p,
        velocity=addVer3 v newVel}
    where
        getRandomVel=do
            gx <- newStdGen
            (x,gy) <- return $ randomR ( -0.003, 0.003) gx
            (y,gz) <- return $ randomR ( -0.003, 0.003) gy
            (z,g') <- return $ randomR ( -0.003, 0.003) gz
            return $ Vertex3 x y z

--個数　場所　方向
newParticles::Int->Point->Point->IO [GameObject]
newParticles 0 _ _ = return []
newParticles n p v= do
    new <- newParticle p v
    ps<- newParticles (n-1) p v
    return (new:ps)
    
main = do
    --Gameを作る
    keyState <- newIORef Set.empty
    gameState <- newIORef Game{
        player=Player{position=Vertex3 0 0 0, velocity=Vertex3 0 0 0},
        objects=[],
        keys=keyState}
    gameRenderer <- newIORef Renderer{
        rendererFunc=display gameState, game=gameState}
    --GLUTの初期化
        initialDisplayMode $= [RGBAMode, DoubleBuffered]
        initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "Particle"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display gameState-- gameState
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just (reshape gameState)
    
    --キーボードやマウスのコールバック
    keyboardMouseCallback $= Just (keyboardProc keyState)
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc gameRenderer
    
    --GLUTのメインループに入る
    mainLoop
    
display gameState= do
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    gs <- readIORef gameState
    
    setCenter gs
    
    pointSize $=4.0
    --表示
    showParticles    $ objects gs
    showPlayer        $ player gs
    
    --バッファの入れ替え
    swapBuffers
    
    where
        showParticles os = preservingMatrix $ do
            renderPrimitive Points $ mapM_
                vertex$ map position os
            
        showPlayer Player{position=Vertex3 x y z, velocity=_} =
            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 <- readIORef $ keys gs
    --プレイヤーを動かす
    ppos <- return $ position $ player gs
    pvel <- return $ velocity $ player gs
    addVecList    <- return $ map (`searchMap` vectorMap) $ Set.elems ks 
    addVec        <- return $ foldl (addVer3) (Vertex3 0 0 0) addVecList
    --プレイヤーが動くならパーティクルを吐く
    Vertex3 x y z <- return addVec
    ps <-if or [null addVecList, addVec==Vertex3 0 0 0]
        then return [] 
        else newParticles 32 (addVer3 ppos pvel) (addVer3 pvel (Vertex3 (-x) (-y) (-z)))
    newPlayer <- return Player{
        position=addVer3 ppos pvel,
        velocity=addVer3 pvel addVec
    }
            
    writeIORef game 
        Game{
            player    =newPlayer,
            objects    =take 10240 $ ps++(updateObjects$objects gs),
            keys    =keys gs}
    where
        searchMap f ((ch,v):xs)= if f==ch then v else searchMap f xs
        searchMap f []=Vertex3 0 0 0
        vectorMap = [
            (SpecialKey KeyLeft,    Vertex3 (-0.003) 0 0),
            (SpecialKey KeyRight,    Vertex3 0.003 0 0),
            (SpecialKey KeyUp,        Vertex3 0 0.003 0),
            (SpecialKey KeyDown,    Vertex3 0 (-0.003) 0)]
                

timerProc::IORef GameRenderer->IO ()
timerProc grRef = do
    gr <- readIORef grRef
    modifyGame $ game gr
    gs <- readIORef $ game gr
    rendererFunc gr
    addTimerCallback timerInterval $ timerProc grRef

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 (1.0)) (Vertex3 x y 0.0) (Vector3 0.0 1.0 0.0)

--ウィンドウのサイズが変更された時の処理
reshape gameState size@(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
    
    --少し後ろから撮影
    setCenter gs
    matrixMode $= Modelview 0
      
--キー入力の処理
keyboardProc keySet ch state _ _
    | ch     == Char 'q'    = exitWith ExitSuccess        --qが押されたら終了
    | state    == Down        = modifyIORef keySet (Set.insert ch)
    | state    == Up        = modifyIORef keySet (Set.delete ch)
    | otherwise            = return ()

↑

解説 †

GLUT的な変更点はありません．
IORefなSetを使ってキーの状態を覚えています．この辺り

| state	== Down		= modifyIORef keySet (Set.insert ch)
| state	== Up		= modifyIORef keySet (Set.delete ch)

↑

アルファブレンド †

半透明に合成できるとかっこいいエフェクトを作る事ができます．

↑

注意 †

今まではパーティクルの表示にPointsを使っていましたが，私の使っているノートPCがPointSpritesに未対応だった為
今後の事を考え，今回から3DSprite(ビルボード)を利用しています*1．

↑

ソース †

module Main where

import Graphics.UI.GLUT hiding (position)
import Graphics.Rendering.OpenGL.GLU

import System
import System.Random
import Data.IORef
import Control.Monad
import qualified Data.Set as Set
import qualified Data.Map as Map

--タイマの間隔
timerInterval = 16

type Point= Vertex3 GLdouble

data GameObject =
        Particle{position::Point, velocity::Point, temperature::Float}
    |    Player{position::Point, velocity::Point}

data GameState = Game{
    player::GameObject,
    objects::[GameObject],
    keys::IORef (Set.Set Key)}
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)
            
updateObject::GameObject->GameObject
updateObject Particle{position=pos, velocity=vel, temperature=temp}
    =Particle{
        position = addVer3 pos vel,
        velocity = vel,
        temperature=temp-1}

updateObjects::[GameObject]->[GameObject]
updateObjects [] = []
updateObjects (o:os)
    =case o of
        Particle{position=_, velocity=_, temperature=_} ->
            if temperature o > 0
                then updateObject o:(updateObjects os)
                else updateObjects os
        otherwise -> updateObjects os
    where
        getY (Vertex3 _ y _) = y
    
tempAve=50
newParticle::Point->Point->IO GameObject
newParticle p v=do
    newVel <- getRandomVel
    newTemp<- getRandomTemp
    return Particle{
        position=p,
        velocity=addVer3 v newVel,
        temperature=newTemp}
    where
        getRandomTemp=do
            g <- newStdGen
            (t,g') <- return $ randomR (tempAve-10, tempAve+10) g
            return t
        getRandomVel=do
            gx <- newStdGen
            (x,gy) <- return $ randomR ( -0.006, 0.006) gx
            (y,gz) <- return $ randomR ( -0.006, 0.006) gy
            (z,g') <- return $ randomR ( -0.006, 0.006) gz
            return $ Vertex3 x y z

--個数　場所　方向
newParticles::Int->Point->Point->IO [GameObject]
newParticles 0 _ _ = return []
newParticles n p v= do
    new <- newParticle p v
    ps<- newParticles (n-1) p v
    return (new:ps)
    
main = do
    --Gameを作る
    keyState <- newIORef Set.empty
    gameState <- newIORef Game{
        player=Player{position=Vertex3 0 0 0, velocity=Vertex3 0 0 0},
        objects=[],
        keys=keyState}
    gameRenderer <- newIORef Renderer{
        rendererFunc=display gameState, game=gameState}
    --GLUTの初期化
        initialDisplayMode $= [RGBAMode, DoubleBuffered]
        initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "Particle"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display gameState-- gameState
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just (reshape gameState)
    
    --キーボードやマウスのコールバック
    keyboardMouseCallback $= Just (keyboardProc keyState)
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc gameRenderer
    
    --GLUTのメインループに入る
    mainLoop
    
display gameState= do
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    blend$=Enabled
    blendFunc $= (SrcAlpha, OneMinusSrcColor)
            
    --単位行列を読み込む
    loadIdentity
    
    gs <- readIORef gameState
    
    setCenter gs
    
    pointSize $=4.0
    --表示
    showParticles    (objects gs)
    showPlayer        $ player gs
    
    --バッファの入れ替え
    swapBuffers
    
    where
        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]
        showParticles []= return ()
        showParticles (o:os) = do
            color (tempToColor4 (temperature o) 0.8)
            preservingMatrix $ renderPrimitive Triangles $ do
                mapM_ vertex $ map (addVer3 $ position o) $ getSprite 0.04
            showParticles os
            
        showPlayer Player{position=Vertex3 x y z, velocity=_} = do
            color $ Color3 (1.0::Double) 1.0 1.0
            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 <- readIORef $ keys gs
    --プレイヤーを動かす
    ppos <- return $ position $ player gs
    pvel <- return $ velocity $ player gs
    addVecList    <- return $ map (`searchMap` vectorMap) $ Set.elems ks 
    addVec        <- return $ foldl (addVer3) (Vertex3 0 0 0) addVecList
    --プレイヤーが動くならパーティクルを吐く
    Vertex3 x y z <- return addVec
    ps <-if or [null addVecList, addVec==Vertex3 0 0 0]
        then return [] 
        else newParticles 8 (addVer3 ppos pvel) (addVer3 pvel (Vertex3 (-x) (-y) (-z)))
    newPlayer <- return Player{
        position=addVer3 ppos pvel,
        velocity=addVer3 pvel addVec
    }
            
    writeIORef game 
        Game{
            player    =newPlayer,
            objects    =ps++(updateObjects$objects gs),
            keys    =keys gs}
    where
        searchMap f ((ch,v):xs)= if f==ch then v else searchMap f xs
        searchMap f []=Vertex3 0 0 0
        vectorMap = [
            (SpecialKey KeyLeft,    Vertex3 (-0.003) 0 0),
            (SpecialKey KeyRight,    Vertex3 0.003 0 0),
            (SpecialKey KeyUp,        Vertex3 0 0.003 0),
            (SpecialKey KeyDown,    Vertex3 0 (-0.003) 0)]
                

timerProc::IORef GameRenderer->IO ()
timerProc grRef = do
    gr <- readIORef grRef
    modifyGame $ game gr
    gs <- readIORef $ game gr
    rendererFunc gr
    addTimerCallback timerInterval $ timerProc grRef

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 (1.0)) (Vertex3 x y 0.0) (Vector3 0.0 1.0 0.0)

--ウィンドウのサイズが変更された時の処理
reshape gameState size@(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
    
    --少し後ろから撮影
    setCenter gs
    matrixMode $= Modelview 0
      
--キー入力の処理
keyboardProc keySet ch state _ _
    | ch     == Char 'q'    = exitWith ExitSuccess        --qが押されたら終了
    | state    == Down        = modifyIORef keySet (Set.insert ch)
    | state    == Up        = modifyIORef keySet (Set.delete ch)
    | otherwise            = return ()

↑

説明 †

アルファブレンドを有効にする為に

blend$=Enabled

アルファブレンドの仕方を

blendFunc $= (SrcAlpha, OneMinusSrcColor)

のように指定します．
後は色を指定する際にColor4を使って，4番目の色の要素に透明度を指定します(0が透明，1.0が不透明)

color (Color4 1.0 0 0 0.5)

詳しい使い方は，OpenGLの説明をしたページでglBlendFunc関数について調べるとよいでしょう．

公式ページ

↑

文字を表示 †

GLUTではビットマップフォントとストロークフォントによる文字の描画をサポートしていますが
Haskellからもこの機能が利用して文字を描く事ができます．

↑

ソース †

import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU

main = do
    --GLUTの初期化
    initialDisplayMode $= [RGBAMode, DoubleBuffered]
    initialWindowSize $= Size 640 480
    
    --ウィンドウを作る
    createWindow "renderString sample"
    
    --表示に使うコールバック関数の指定
    displayCallback $= display
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just reshape

    --GLUTのメインループに入る
    mainLoop

display = do
    --背景を青にする
    clearColor $= Color4 0.0 0.0 1.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    --表示
    lineWidth $= 4.0
    preservingMatrix $ do
        scale (0.001::Double) 0.001 0.001
        w <- stringWidth Roman "Stroke font"
        translate (Vector3 (-0.5*(fromIntegral w)) 0 0 ::Vector3 Float)
        renderString Roman "Stroke font"
        
    --バッファの入れ替え
    swapBuffers
    
--ウィンドウのサイズが変更された時の処理
reshape size@(Size w h)=do
    viewport $= (Position 0 0, size) --ウィンドウ全体を使う
    
    --ビューボリュームの設定
    matrixMode $= Projection
    loadIdentity
    perspective 60.0 (fromIntegral w / fromIntegral h) 0.001 50.0
    
    --少し後ろから撮影
    lookAt (Vertex3 0.0 0.0 1.0) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
    matrixMode $= Modelview 0

↑

説明 †

ビットマップフォントは思った動作をさせる事ができなかったので使っていません．
ストロークフォントの描画には，renderStringを使います．
このストロークフォントは，Lineとして書かれているので
translateやscale,lineWidth等の関数を適用できます．
また，stringWidthを使うことで，文字列を表示した時の幅を求める事もできます．

公式ドキュメント

↑

参考にした物 †

Haskell Hierarchical Libararies
GHCのライブラリの説明．

HaskellOpenGl
planet.cのHaskellへの移植があります．

モナディックシューティング
Haskellで書かれたシューティングゲーム．
適度に複雑で，適度にシンプルな分かりやすいサンプルになると思います．

h_sakuraiの日記 -Haskellのシューティングを読む
モナディックシューティングの簡単な解説．

Yet another Reimeinikki -HOpenGL 事始め
とてもシンプルなHaskell+OpenGLのコード．

布シミュ
過去に書いたGLUTのプログラム．
自分のプログラムが，GLUT思い出すのに一番役に立ちます^^

↑

コメント †

インデントが崩れて，コンパイルが通らない事があるみたいです．報告をいただけたら修正します．
Safii 2006-09-22 11:44:29 (金)
いくつかのサンプルで”GLUTの初期化”というところのインデントがずれているようです。 -- a_kawashiro 2012-10-25 08:42:09 (木)
Ubuntu + GHC 7.4.1 では”initialWindowSize $= Size 640 480”の下に” initialize "" [] ”を追加しないとコンパイルが通りません -- a_kawashiro 2012-10-25 08:46:11 (木)
” import System ”というところは” import System.Exit ”とすると良いようです。(Ubuntu + GHC 7.4.1) -- a_kawashiro 2012-10-25 08:48:17 (木)

*1 今回のプログラムはPointSprites未対応でもPointsで表示できると思います

添付ファイル:

string.png 1967件 [詳細]

particle3.png 1759件 [詳細]

particle2.png 1882件 [詳細]

particle.png 2236件 [詳細]

プログラミング / Haskell / GLUT
/GLUT

GLUTのインストール †

$=演算子 †

四角形をぐるぐる回す †

解説 †

キーボードからの入力を受ける †

コード †

変更点 †

パーティクル †

ソース †

解説 †

彗星 †

ソース †

解説 †

アルファブレンド †

注意 †

ソース †

説明 †

文字を表示 †

ソース †

説明 †

参考にした物 †

コメント †

お品書き

最近更新の blog/ 5件

最近更新の 20件

プログラミング / Haskell / GLUT/GLUT

GLUTのインストール †

$=演算子 †

四角形をぐるぐる回す †

解説 †

キーボードからの入力を受ける †

コード †

変更点 †

パーティクル †

ソース †

解説 †

彗星 †

ソース †

解説 †

アルファブレンド †

注意 †

ソース †

説明 †

文字を表示 †

ソース †

説明 †

参考にした物 †

コメント †

お品書き

最近更新の blog/ 5件

最近更新の 20件

プログラミング / Haskell / GLUT
/GLUT