YampaとOpenGL(GLUT)で簡単なシューティングゲームを作成する―グラフィックス

１．概略

ゲームの出力を行うのはグラフィックスである。広く利用されているのはOpenGLである。その簡易版はGLUTである。また、最近ではSDL(Simple DirectMedia Layer)も広く利用されている。このシューティングゲームではGLUTを用いる。

ゲームの進行状況を画面に出力するためには、初期化とその時々の画像の描画とが必要である。初期化は通常は定められた方法で行う。描画は登場者の位置情報を得て描く。このシューティングゲームでは、それぞれのサイクルの終了時に得られた登場者の状態から、その位置を獲得して、石や鳥を描く。

もう一度、このシューティングゲームのビデオを見ると、

鳥は緑色の多面体で、石は赤い球で表示される。そして、石が鳥にあたると鳥は消えてしまう。石のほうは、何もなかったかのようにそれまでの軌跡を継続する。では、プログラムがどのようになっているか説明する。

２．初期化

初期化のプログラムは次の通りである。

initGL :: IO ()
initGL = do
  _ <- getArgsAndInitialize
  _ <- createWindow "Shooting Game"
  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
  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というプログラムで行う。メインのプログラムから登場者状態の識別リスト(型シグネチャではIL ObjOutout、本体ではoos)が渡されるので、このリストより登場者状態のリスト(elemsIL oos)を得る。そこから、(forM_を用いて）個々の搭乗者状態に対して、その種類と位置を得て、描画の関数draw'を実行する。

draw'では、種類から石であるのか鳥であるのかの情報を得て、石であれば球を、鳥であれば多面体を与えられた位置に描画する。

プログラムは次のようになっている。

draw :: IL ObjOutput -> IO ()
draw oos = do
  clear [ ColorBuffer, DepthBuffer ]
  loadIdentity
  forM_  (elemsIL oos)  (\oo -> draw' (ooKind oo) (position' (ooState oo)))
  flush
  
draw' :: ObjectKind -> Pos -> IO ()
draw' kind pos
  | kind == Stone = renderStone $ vector3 (unsafeCoerce (fst pos)) (unsafeCoerce (snd pos)) (-30)
  | kind == Bird  = renderBird  $ vector3 (unsafeCoerce (fst pos)) (unsafeCoerce (snd pos)) (-30)
  | otherwise     = error "Unexpected errors occur in graphics because of an undefined kind"
  where
    size2 :: GLdouble
    size2 = (fromInteger $ 6)/2
    green  = Color4 0.8 1.0 0.7 0.9 :: Color4 GLdouble
    greenG = Color4 0.8 1.0 0.7 1.0 :: Color4 GLdouble
    red    = Color4 1.0 0.7 0.8 1.0 :: Color4 GLdouble
    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
    renderStone   = (color red >>) . (renderShapeAt $ Sphere' 0.5 20 20)
    renderBird    = (color green >>) . (renderShapeAt $ Icosahedron)

４．モジュールGraphicsのプログラム

最後になるが、これまでのプログラムをmodule Graphicsとしてまとめたものを掲載しておく。

module Graphics where

import           FRP.Yampa.Vector3
import           Unsafe.Coerce

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

import Control.Monad (forM_)

import           Types
import           IdentityList

initGL :: IO ()
initGL = do
  _ <- getArgsAndInitialize
  _ <- createWindow "Shooting Game"
  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
  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 :: IL ObjOutput -> IO ()
draw oos = do
  clear [ ColorBuffer, DepthBuffer ]
  loadIdentity
  forM_  (elemsIL oos)  (\oo -> draw' (ooKind oo) (position' (ooState oo)))
  flush
  
draw' :: ObjectKind -> Pos -> IO ()
draw' kind pos
  | kind == Stone = renderStone $ vector3 (unsafeCoerce (fst pos)) (unsafeCoerce (snd pos)) (-30)
  | kind == Bird  = renderBird  $ vector3 (unsafeCoerce (fst pos)) (unsafeCoerce (snd pos)) (-30)
  | otherwise     = error "Unexpected errors occur in graphics because of an undefined kind"
  where
    size2 :: GLdouble
    size2 = (fromInteger $ 6)/2
    green  = Color4 0.8 1.0 0.7 0.9 :: Color4 GLdouble
    greenG = Color4 0.8 1.0 0.7 1.0 :: Color4 GLdouble
    red    = Color4 1.0 0.7 0.8 1.0 :: Color4 GLdouble
    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
    renderStone   = (color red >>) . (renderShapeAt $ Sphere' 0.5 20 20)
    renderBird    = (color green >>) . (renderShapeAt $ Icosahedron)