bitterharvest’s diary

A Bitter Harvestは小説の題名。作者は豪州のPeter Yeldham。苦闘の末に勝ちえた偏見からの解放は命との引換になったという悲しい物語

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

6.デモ

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

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

7.オブジェクトのプログラム

それでは、鳥と石のオブジェクトのプログラムを考える。鳥は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)

8.オブジェクトのプログラムの全体

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

{-# 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) 

9.残りのプログラム

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