YampaとOpenGL(GLUT)で簡単なシューティングゲームを作成する―登場者の信号関数

１．概略

ゲームプログラムの登場人物、このシューティングゲームでは石二つと鳥一羽、の振舞いを定義しなければならない。どの石も同じ振舞いをすることにすると、ここでは、石と鳥の二種類の振舞いを定める必要がある。Yampaでは登場者の振舞いは信号関数を用いて定義する。ゲームが進行していく最小の単位である一つのサイクルの中で、サイクル開始時の登場者の状態を得て、信号関数を利用して、サイクル終了時の登場者の状態を得る必要がある。信号関数は、物理法則や、電気現象や、化学現象などの法則を表したものであり、同じ入力に対して、同じ出力を与える。即ち、信号関数は状態を持たない。

ゲームでは、入力デバイスや登場者間の干渉によって、登場者の振舞いが変化することがある。例えば、ボールが壁に当たって跳ね返るときである。このような現象を一般にイベントと呼んでいるが、イベントが発生したときは、今まで利用していた信号関数から別の信号関数に切り替わる。Yampaではこの切り替えをSwitchという関数で実現できるようにしている。

イベントの処理は、サイクル内で処理される場合もあるし、次のサイクルへと伝えられる場合もある。このシューティングゲームでは、石が飛び跳ねるのは同じサイクルの中で処理されるが、石にあたった鳥が退場する処理は次のサイクルへと伝えられる。

登場者が一つのサイクルを終了すると、終了時の新たな状態が出力される。その出力の中には、サイクルの中で起きた（次のサイクルに伝える）イベントも含まれる。このシューティングゲームでは、鳥が石にあたったときは、「退場」というイベントが出力される状態の中に含まれる。

２．飛び跳ねる石の信号関数

飛び跳ねる石の信号関数は、飛び跳ねるボールの記事で説明した信号関数を用いる。但し、信号関数の出力はそのサイクルが終了した時点での石の状態になるのでこの点を変更する。そこで、石の信号関数StoneObjectは次のようになる。

stoneObject :: Pos -> Vel -> Object
stoneObject pos0 vel0 = proc _ -> do
  (pos, vel) <- bouncingBall pos0 vel0 -< ()
  returnA -< defaultObjOutput{ooKind = Stone, ooState = State {position' = pos, velocity = vel}}

StoneObjectの型シグネチャは次のようになっている。位置Posと速度Velを入力して、Objectを出力するである。後の記事で説明するが、Objectは信号関数のニーモニックである。

StoneObjectのプログラム本体は次のようになっている。引数はサイクル開始時の石の位置pos0と速度vel0である。これを石の振舞いを定める信号関数bouncingBallに適応し、サイクル終了時の石の位置posと速度velを得る。次にdefaultObjOutputを作成する。これは、石の現在の状態を示す登場者の状態を生み出すことに相当する。defaultObjOutputはレコード構文になっているが、用意されているフィールドに必要な値を埋め込む。ここでは、登場者の種類を示すooKindにStoneを、位置情報などを示すooStateに現在の位置と速度を埋め込んだ。これにより、returnAによって、この信号関数の出力として、現在の石の状態が送出される。

信号関数boucingBallは以前に説明したものと同じである。

bouncingBall :: Pos -> Vel -> SF () (Pos, Vel)
bouncingBall pos0 vel0 = switch (bb pos0 vel0) (\ (pos, vel) -> if abs (snd vel) <= 1 then constant ((fst pos, 0), (0, 0)) else bouncingBall pos ((fst vel), (- (snd vel)) * 0.6))
  where bb pos0' vel0' = proc _ -> do
          (pos, vel) <- fallingBall pos0' vel0' -< ()
          event <- edge -< snd pos <= 0
          returnA -< ((pos, vel), event `tag` (pos, vel))
fallingBall :: Pos -> Vel -> SF () (Pos, Vel)
fallingBall pos0 vel0 = proc _ -> do
  vel <- (vel0 ^+^) ^<< integral -< (0, -9.81)
  pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< (pos, vel)

上記のプログラムで、switchの部分が地面にぶつかった時の処理である。switchの右かっこにあるbb pos0 vel0でボールが地面にぶつかるかを検知している。もしそうであれば、右に書かれている信号関数(\ (pos, vel) -> ...)を実行する。そうでなければ、これまでの信号関数を実行する。ぶつかった時に利用される信号関数は、y方向の速度を反転させるものだが、もしその速度が小さければ地面にくっついたままにする。

bouncingBallが利用するfallingBallはニュートン力学の落下の法則を記述したものである。

３．鳥の信号関数

鳥の信号関数birdObjectに移る。鳥は、地面に平行に等速運動をしているものとする。但し、石にぶつかったときは、鳥は退場する。そこで、次のサイクルで退場できるようにするため、ooKillRequestにイベントを立てる。プログラムは次のようになる。

birdObject :: Pos -> Vel -> Object
birdObject pos0 vel0  = proc objEvents -> do
  vel <- (vel0 ^+^) ^<< integral -< (0, 0)
  pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< defaultObjOutput{ooKind = Bird, ooState = State {position' = pos, velocity = vel},
                              ooKillRequest = (oeLogic objEvents)}

石の信号関数と異なる点は、defaultObjOutputを作成するときに、ooKillRequest = (oeLogic objEvents)を行っていることである。これは前回の記事でrouteの説明をしたが、その中のrouteAuxで得たイベントを利用している。

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

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

{-# LANGUAGE Arrows #-}
module Objects where

import FRP.Yampa
import Types

stoneObject :: Pos -> Vel -> Object
stoneObject pos0 vel0 = proc _ -> do
  (pos, vel) <- bouncingBall pos0 vel0 -< ()
  returnA -< defaultObjOutput{ooKind = Stone, ooState = State {position' = pos, velocity = vel}}

bouncingBall :: Pos -> Vel -> SF () (Pos, Vel)
bouncingBall pos0 vel0 = switch (bb pos0 vel0) (\ (pos, vel) -> if abs (snd vel) <= 1 then constant ((fst pos, 0), (0, 0)) else bouncingBall pos ((fst vel), (- (snd vel)) * 0.6))
  where bb pos0' vel0' = proc _ -> do
          (pos, vel) <- fallingBall pos0' vel0' -< ()
          event <- edge -< snd pos <= 0
          returnA -< ((pos, vel), event `tag` (pos, vel))
fallingBall :: Pos -> Vel -> SF () (Pos, Vel)
fallingBall pos0 vel0 = proc _ -> do
  vel <- (vel0 ^+^) ^<< integral -< (0, -9.81)
  pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< (pos, vel)

birdObject :: Pos -> Vel -> Object
birdObject pos0 vel0  = proc objEvents -> do
  vel <- (vel0 ^+^) ^<< integral -< (0, 0)
  pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< defaultObjOutput{ooKind = Bird, ooState = State {position' = pos, velocity = vel},
                              ooKillRequest = (oeLogic objEvents)}