物理的なモデルに基づいてゲームを開発する：OpenGLで描画

１．落下する物体を描画する

前回の記事で、FRPを用いて落下するボールの刻々と変化する高さと時間を数字で出力した。ここでは、直感的に分かりやすくするために、GLUT(The OpenGL Utility Kit)を用いて、描画する。コードは同じようにJekorが動画で説明したものである。まず、全体のコードを示す。

import FRP.Yampa
import Control.Concurrent
import FRP.Yampa.Vector3
import FRP.Yampa.Utilities
import Unsafe.Coerce

import Graphics.UI.GLUT hiding (Level,Vector3(..),normalize)
import qualified Graphics.UI.GLUT as G(Vector3(..))


type Pos = Double
type Vel = Double
type R = GLdouble


fallingBall :: Pos -> SF () (Pos, Vel)
fallingBall y0 = (constant (-9.81) >>> integral) >>> ((integral >>^ (+ y0)) &&& identity)


initGL :: IO ()
initGL = do
    getArgsAndInitialize
    createWindow "Bounce"
    initialDisplayMode $= [ WithDepthBuffer, DoubleBuffered ]
    depthFunc          $= Just Less
    clearColor         $= Color4 0 0 0 0
    light (Light 0)    $= Enabled
    lighting           $= Enabled
    lightModelAmbient  $= Color4 0.5 0.5 0.5 1
    diffuse (Light 0)  $= Color4 1 1 1 1
    blend              $= Enabled
    blendFunc          $= (SrcAlpha, OneMinusSrcAlpha)
    colorMaterial      $= Just (FrontAndBack, AmbientAndDiffuse)
    reshapeCallback    $= Just resizeScene
    return ()

resizeScene :: Size -> IO ()
resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero
resizeScene s@(Size width height) = do
  -- putStrLn "resizeScene"
  viewport   $= (Position 0 0, s)
  matrixMode $= Projection
  loadIdentity
  perspective 45 (w2/h2) 1 1000
  matrixMode $= Modelview 0
 where
   w2 = half width
   h2 = half height
   half z = realToFrac z / 2

draw :: Pos -> IO ()
draw pos = do
    clear [ ColorBuffer, DepthBuffer ]
    loadIdentity
    renderPlayer $ vector3 2 (unsafeCoerce pos) 2
    flush
    where size2 :: R
          size2 = (fromInteger $ 6)/2
          green  = Color4 0.8 1.0 0.7 0.9 :: Color4 R
          greenG = Color4 0.8 1.0 0.7 1.0 :: Color4 R
          red    = Color4 1.0 0.7 0.8 1.0 :: Color4 R
          renderShapeAt s p = preservingMatrix $ do
            translate $ G.Vector3 (0.5 - size2 + vector3X p)
                                  (0.5 - size2 + vector3Y p)
                                  (0.5 - size2 + vector3Z p)
            renderObject Solid s
          renderObstacle = (color green >>) . (renderShapeAt $ Cube 1)
          renderPlayer   = (color red >>) . (renderShapeAt $ Sphere' 0.5 20 20)
          renderGoal     =
            (color greenG >>) . (renderShapeAt $ Sphere' 0.5 20 20)

main = reactimate (initGL)
                       (\ _ -> threadDelay 100000 >> return (0.1, Nothing))
                       (\ _ (pos, vel) -> putStrLn ("pos: " ++ show pos ++ ", vel: " ++ show vel) >> draw pos >> return False)
                       (fallingBall 10.0)

プログラムの要所だけを説明する。

まず、mainの部分だが、OpneGLで描画するために、出力文のところにdraw posを加えてある。また、reactimateのinitのところはinitGLとし、OpenGLを初期化する。このための、関数initGLは、プログラムの最初のほうに書いてある。とりあえずはこのまま使い、気に入らなければ背景色を変えるなどすればよい。

次の関数resizeも画面の大きさにかかわるものだが、これも、とりあえずこのまま用いるとよい。

最後の関数drawは描画に用いられる。renderPlayerのところで、落下するボールを与える。ここでは、3次元のベクトルで与える。ボールはy方向に落下するので、ここに、ボールの高さposを与える。なお、3次元ベクトルでの型とposの型が異なるので、それを無視するためにunsafeCoerceを用いる。

実行すると、Haskell Platformの2014年版ではボールが落ちていく様子を見ることができるが、2013年版ではOpenGLの画面が現れない。2014年版では、GLUTが改定されたのでそのためと思われる。