YampaとOpenGL(GLUT)で簡単なシューティングゲームを作成する―発射と停止を加える（２）

６．デモ

今回のプログラムの実行状況をビデをで説明する。

余り、代わり映えしないのだが、PgUpキーを押すと鳥が動き出すと同時に石が発射され、PgDnキーを押すと鳥と石が消える。

７．オブジェクトのプログラム

それでは、鳥と石のオブジェクトのプログラムを考える。鳥はPgUpキーが押されるまでは出発点にとどまる。PgUpキーが押されると飛び出すことになる。鳥のオブジェクトをbirdObjectで表し、出発点にとどまっているときの信号関数をstayingBirdとし、飛んでいるときの信号関数をflyingBirdとする。

birdObjectは最初に信号関数stayingBirdを使用するので次のようになる。

birdObject :: Pos -> Vel -> Object
birdObject pos0 vel0  = proc input -> do
  rec
    (pos, vel) <- stayingBird pos0 vel0 -< input
  returnA -< defaultObjOutput{ooKind = Bird, ooState = State {position' = pos, velocity = vel},
                              ooKillRequest = (oeLogic input)}

なお、recは再帰的であることを表すアロー記法である。一般的には、returnAの前に複数行存在し、そこでの値は再帰的に定められる。これは常套的に利用されるので、今回はそのようにした。

stayingBirdを利用しているときに、PgUpキーが押されると、信号関数flyingBirdを利用する。PgUpキーが押されたかどうかの判断はisEvent (upEvs (oeInput input))で行えるので、stayingBirdのプログラムは次のようになる。

stayingBird :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBird pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel) -> flyingBird pos vel)
  where flyaway pos0' vel0' = proc input -> do
          rec
            evt <- edge -< isEvent (upEvs (oeInput input))
          returnA -< ((pos0', vel0'), evt `tag` (pos0', vel0'))

flyingBirdは前のままで、以下のとおりである。

flyingBird :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
flyingBird pos0 vel0  = proc _ -> do
  rec
    vel <- (vel0 ^+^) ^<< integral -< (0, 0)
    pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -<  (pos, vel) 

石の場合も同じようにする。発射前のとどまっている状態を表す信号関数をstayingBallとすると、石の部分は次のようななる。

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

stayingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBall pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel) -> bouncingBall pos vel)
  where flyaway pos0' vel0' = proc input -> do
          rec
            evt <- edge -< isEvent (upEvs (oeInput input))
          returnA -< ((pos0', vel0'), evt `tag` (pos0', vel0'))

bouncingBall :: Pos -> Vel -> SF ObjEvents (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 input -> do
          rec
            (pos, vel) <- fallingBall pos0' vel0' -< input
            evt <- edge -< snd pos <= 0
          returnA -< ((pos, vel), evt `tag` (pos, vel))
          
fallingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
fallingBall pos0 vel0 = proc _ -> do
  rec
    vel <- (vel0 ^+^) ^<< integral -< (0, -9.81)
    pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< (pos, vel)

８．オブジェクトのプログラムの全体

オブジェクトプログラムの全体を示すと以下のとおりである。

{-# LANGUAGE Arrows #-}
module Objects where

import FRP.Yampa
import Types

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

stayingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBall pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel) -> bouncingBall pos vel)
  where flyaway pos0' vel0' = proc input -> do
          rec
            evt <- edge -< isEvent (upEvs (oeInput input))
          returnA -< ((pos0', vel0'), evt `tag` (pos0', vel0'))

bouncingBall :: Pos -> Vel -> SF ObjEvents (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 input -> do
          rec
            (pos, vel) <- fallingBall pos0' vel0' -< input
            evt <- edge -< snd pos <= 0
          returnA -< ((pos, vel), evt `tag` (pos, vel))
          
fallingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
fallingBall pos0 vel0 = proc _ -> do
  rec
    vel <- (vel0 ^+^) ^<< integral -< (0, -9.81)
    pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -< (pos, vel)

birdObject :: Pos -> Vel -> Object
birdObject pos0 vel0  = proc input -> do
  rec
    (pos, vel) <- stayingBird pos0 vel0 -< input
  returnA -< defaultObjOutput{ooKind = Bird, ooState = State {position' = pos, velocity = vel},
                              ooKillRequest = (oeLogic input)}



stayingBird :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBird pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel) -> flyingBird pos vel)
  where flyaway pos0' vel0' = proc input -> do
          rec
            evt <- edge -< isEvent (upEvs (oeInput input))
          returnA -< ((pos0', vel0'), evt `tag` (pos0', vel0'))

flyingBird :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
flyingBird pos0 vel0  = proc _ -> do
  rec
    vel <- (vel0 ^+^) ^<< integral -< (0, 0)
    pos <- (pos0 ^+^) ^<< integral -< vel
  returnA -<  (pos, vel) 

９．残りのプログラム

この簡単なシューティングゲームを動かすためには、出力の部分であるグラフィックスと、識別リストが必要であるが、これは、前に説明したものと同じであるので、ここでは省略する。