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

３．発射台の位置の移動をスムーズに

前回の記事で発射台の位置を移動できるようになった。しかし、残念なことに、その動きはスムーズではなかった。ここでは、発射台をスムーズに移動できるようにする。即ち、dのキーを押し続けている間は右に移動し、aのキーを押し続けている間は左に移動するようにする。出来上がったプログラムは動作例を下のビデオで示す。

４．入力の変更

キーを押し続けているとき、一単位時間でのカウント速度aとして、カウント数を求める関数keyIntegralを次のように定義する。

keyIntegral :: Double -> SF (Event a) Double
keyIntegral a = let eventToSpeed (Event _) = a
                    eventToSpeed NoEvent   = 0 
                in arr eventToSpeed >>> integral 

信号関数parseInputには、キーa,dが押されたときのカウント数を加えた。

parseInput :: SF (Event Input) ParsedInput
parseInput = proc i -> do
    down <- filterKeyDowns                  -< i
    aCnt <- countKey 'a'                    -< down
    dCnt <- countKey 'd'                    -< down
    uEvs <- filterKey (SpecialKey KeyUp)    -< down
    dEvs <- filterKey (SpecialKey KeyDown)  -< down
    rEvs <- filterKey (SpecialKey KeyRight) -< down
    lEvs <- filterKey (SpecialKey KeyLeft)  -< down
    returnA -< ParsedInput aCnt dCnt uEvs dEvs rEvs lEvs
    where filterKey k = arr $ filterE ((==k) . key)
          countKey c  = filterE ((==(Char c)) . key) ^>> keyIntegral 1

５．データ型の変更

データ型ParsedInputにも、キーa,dからのカウント数が次のように加わるようにした。

data ParsedInput = ParsedInput { aCount   :: Double, 
                                 dCount   :: Double,
                                 upEvs    :: Event Input, 
                                 downEvs  :: Event Input, 
                                 rightEvs :: Event Input, 
                                 leftEvs  :: Event Input }

６．信号関数の変更

ボールの発射位置を決める信号関数stayingBallも変更する必要がある。ここでは、キーa,dからのカウント数を移動距離として利用した。変更点は次の通りである。①イベントが発生しなかったときの現在の位置は移動した距離で、②発射のイベントが発生したときの現在の位置も移動した距離である。

stayingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBall pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel, no) -> if no == 3 then bouncingBall pos vel else stayingBall pos vel)
  where 
    flyaway :: Pos -> Vel -> SF ObjEvents ((Pos, Vel), Event(Pos, Vel, Integer))
    flyaway pos0' vel0' = proc input -> do
      rec
        evt1 <- edge -< isEvent (rightEvs (oeInput input))
        evt2 <- edge -< isEvent (leftEvs (oeInput input))
        evt3 <- edge -< isEvent (upEvs (oeInput input))
      returnA -< ((((fst pos0') + dCount (oeInput input) - aCount (oeInput input), snd pos0'), vel0'), 
                 if evt1 /= NoEvent then evt1 `tag` (((fst pos0') + 0.5, snd pos0'), vel0', 1)
                 else if evt2 /= NoEvent then evt2 `tag` (((fst pos0') - 0.5, snd pos0'), vel0', 2)
                      else evt3 `tag` (((fst pos0') + dCount (oeInput input) - aCount (oeInput input), snd pos0'), vel0', 3))


{--
stayingBall :: Pos -> Vel -> SF ObjEvents (Pos, Vel)
stayingBall pos0 vel0  = switch (flyaway pos0 vel0) (\ (pos, vel, no) -> if no == 3 then bouncingBall pos vel else stayingBall pos vel)
  where
    flyaway :: Pos -> Vel -> SF ObjEvents ((Pos, Vel), Event(Pos, Vel, Integer)) 
    flyaway pos0' vel0' = proc input -> do
      rec
        evt1 <- edge -< isEvent (rightEvs (oeInput input))
        evt2 <- edge -< isEvent (leftEvs (oeInput input))
        evt3 <- edge -< isEvent (upEvs (oeInput input))
      returnA -< ((pos0', vel0'), if evt1 /= NoEvent then evt1 `tag` (((fst pos0') + 0.5, snd pos0'), vel0', 1)
                                  else if evt2 /= NoEvent then evt2 `tag` (((fst pos0') - 0.5, snd pos0'), vel0', 2)
                                       else evt3 `tag` (pos0', vel0', 3))
--}