14.壁面で跳ね返す
前回の記事の四角いボックスは、キーが押された時、x軸に沿って等速度で左あるいは右に移動した。しかし、側面に壁がないため、いくらでも左あるいは右に進むことができた。この単純なゲームを、もう少し現実的なゲームにするため、両脇に壁を設け、四角いボックスが壁面で跳ね返るようにする。また、キーが押されたときは、速度ではなく、加速度を与えて、スピード感を持たせる。
キーA,Dが押された時、それぞれ、左、右方向に加速度を与えるプログラムは、前回の速度を与えたプログラムをそのまま利用して次のようにする。
acceleration :: (Monoid e) => Wire s e IO a Double acceleration = pure ( 0) . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D') <|> pure (-0.5) . isKeyDown (CharKey 'A') <|> pure ( 0.5) . isKeyDown (CharKey 'D') <|> pure ( 0)
ところで、今回のゲームは、両脇に壁面が設けられている。従って、速度を求めようとすると、壁面に当たったかどうかで判断しなければならない。もし、壁面に当たったのであれば、加速度の方向を逆にして速度を求める必要がある。
Netwireではこのような要求にこたえるために関数integralWithを用意している。integralWithの型シグネチャは次のようになっている。
integralWith :: (Fractional a, HasTime t s) => (w -> a -> a) -> a -> Wire s e m (a, w) a
integralWithは二つの入力を受け付ける。一つは関数(w -> a -> a)で、残りの一つはaである。このうち、後者は積分での定数項である。前者の(w -> a -> a)で、wはワールド値(world value)と呼ばれる。aの方は少し込み入っている。
一般に、定数項\(a_0\)をした時、\(a(t)\)の積分は次の式で求めることができる。
\begin{eqnarray}
a_0 + \int_0^s x(t) dt & = & \\
a_0 && + a(\frac{1}{s}) \times dt + a(\frac{2}{s}) \times dt + ... \\
&& + a(\frac{i}{s}) \times dt + a(\frac{i+1}{s}) \times dt + ... \\
&& + a(\frac{n}{s}) \times dt
\end{eqnarray}
ただし、\(dt = \frac{s}{n}\)
ここで、\(i\)番目までの項を加えたものを\(v_i\)とすると、\(i+1\)番目までの項を加えたものは\(v_i + a(\frac{i+1}{s}) \times dt \)で求めることができる。漸化式になるので、\(i\)が\(n\)になるまで求めればよい。
ところで、計算の途中で衝突が起きたとする。例えば、\(i+1\)の前で衝突が起きたとする。この時、速度が反対になるので、\(v_i\)を\(-v_i\)にする必要がある。
integralWithの定義を見ると次のようになっている。
integralWith :: (Fractional a, HasTime t s) => (w -> a -> a) -- ^ Correction function. -> a -- ^ Integration constant (aka start value). -> Wire s e m (a, w) a integralWith correct = loop where loop x' = mkPure $ \ds (dx, w) -> let dt = realToFrac (dtime ds) x = correct w (x' + dt*dx) in x' `seq` (Right x', loop x)
上の説明とは少し異なっていて、衝突が起きた場所を正確には反映されずに、最初の\(i=0\)から衝突があったものとしている(一つのセッションが微小であるとするとこのように仮定しても問題はない)。従って、衝突が起きた場合には、最初から速度の方向を逆転させて計算している。
aについて込み入った話をしたが、衝突があった場合には速度を反転させるということなので、プログラムは次のようになる。
integralWithを用いると、速度は次のように求めることができる。
velocity :: (Monad m, HasTime t s, Monoid e) => Wire s e m (Double, Bool) Double velocity = integralWith bounce 0 where bounce c v | c = -v | otherwise = v
上のプログラムで、bounceが加速度aから、速度vを出力するプログラムである。bounceの入力の一つは先ほど出てきた速度\(v_i\)で、もう一つの入力は衝突の有無を知らせるcである。加速度aと衝突の有無cは、velocityの型シグネチャでの(Double, Bool)で入力されることが分かる。bounceは、衝突がなければ、この加速度aから速度vを得るが、衝突があるときはその速度vを反転させる。
次に、位置を示すプログラムは、次の位置を出力するとともに、その時、衝突したかどうかを教える必要がある。そこで、積分の関数integralを改造して、衝突したかどうかの情報も一緒に出力する関数integralWith'を用意する。これは次のようになる。
integralWith' :: (Fractional a, HasTime t s) => (a -> (a, o)) -> a -> Wire s e m a (a, o) integralWith' correct = loop where loop x' = mkPure $ \ds dx -> let dt = realToFrac (dtime ds) (x,b) = correct (x' + dt*dx) in x' `seq` (Right (x', b), loop x)
上記の型シグネチャで、最初の入力(a -> (a, o))が、衝突したかどうかを判定する関数である。この関数は、次の位置aと衝突が生じたかどうかの真理値を返す。二番目の入力aは定数項である。
左と右の壁面の(x軸上の)位置をlSide,rSideとすると、位置position'は次のようになる。下記のプログラムで、clampが壁面に衝突しているかどうかを判定している。また、衝突した場合には、衝突後の正しい位置を求めている。
position' :: (Monad m, HasTime t s) => Wire s e m Double (Double, Bool) position' = integralWith' clamp 0 where clamp p | p < lSide = (lSide * 2 - p, True) | p > rSide = (rSide * 2 - p, True) | otherwise = (p, False)
速度の関数は、加速度と位置の関数から値を受け取り、位置の関数は速度から値を受け取る。このため、相互に再帰的になっている。このような関数を実行するときは、これらが並行して動けるようにするためrecを用いる。そこで、bouncingという関数を用意して、次のように、acceletion, velocity, position'が並行で動けるようにした。
bouncing :: (HasTime t s) => Wire s () IO a Double bouncing = proc _ -> do rec a <- acceleration -< () v <- velocity -< (a, c) (p, c) <- position' -< v returnA -< p
これでプログラムは完成である。後は、OpenGLで定められた枠組みの中に組み込むだけである。
実行の様子を示したのが以下のビデオである。
プログラム全体は次のようになる。
{-# LANGUAGE Arrows #-} import Graphics.Rendering.OpenGL import Graphics.UI.GLFW import Data.IORef import Prelude hiding ((.)) import Control.Wire import FRP.Netwire isKeyDown :: (Enum k, Monoid e) => k -> Wire s e IO a e isKeyDown k = mkGen_ $ \_ -> do input <- getKey k return $ case input of Press -> Right mempty Release -> Left mempty acceleration :: (Monoid e) => Wire s e IO a Double acceleration = pure ( 0) . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D') <|> pure (-0.5) . isKeyDown (CharKey 'A') <|> pure ( 0.5) . isKeyDown (CharKey 'D') <|> pure ( 0) velocity :: (Monad m, HasTime t s, Monoid e) => Wire s e m (Double, Bool) Double velocity = integralWith bounce 0 where bounce c v | c = -v | otherwise = v integralWith' :: (Fractional a, HasTime t s) => (a -> (a, o)) -> a -> Wire s e m a (a, o) integralWith' correct = loop where loop x' = mkPure $ \ds dx -> let dt = realToFrac (dtime ds) (x,b) = correct (x' + dt*dx) in x' `seq` (Right (x', b), loop x) lSide = -0.8 rSide = 0.8 position' :: (Monad m, HasTime t s) => Wire s e m Double (Double, Bool) position' = integralWith' clamp 0 where clamp p | p < lSide = (lSide * 2 - p, True) | p > rSide = (rSide * 2 - p, True) | otherwise = (p, False) bouncing :: (HasTime t s) => Wire s () IO a Double bouncing = proc _ -> do rec a <- acceleration -< () v <- velocity -< (a, c) (p, c) <- position' -< v returnA -< p s :: Double s = 0.05 y :: Double y = 0.0 renderPoint :: (Double, Double) -> IO () renderPoint (x, y) = vertex $ Vertex2 (realToFrac x :: GLfloat) (realToFrac y :: GLfloat) generatePoints :: Double -> Double -> Double -> [(Double, Double)] generatePoints x y s = [ (x - s, y - s) , (x + s, y - s) , (x + s, y + s) , (x - s, y + s) ] runNetwork :: (HasTime t s) => IORef Bool -> Session IO s -> Wire s e IO a Double -> IO () runNetwork closedRef session wire = do pollEvents closed <- readIORef closedRef if closed then return () else do (st , session') <- stepSession session (wt', wire' ) <- stepWire wire st $ Right undefined case wt' of Left _ -> return () Right x -> do clear [ColorBuffer] renderPrimitive Quads $ mapM_ renderPoint $ generatePoints x y s swapBuffers runNetwork closedRef session' wire' main :: IO () main = do initialize openWindow (Size 1024 512) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window closedRef <- newIORef False windowCloseCallback $= do writeIORef closedRef True return True runNetwork closedRef clockSession_ bouncing closeWindow