1.石と鳥の軌跡
今回はこの動画のように機能するプログラムを作成する。
今、角度\(\theta =tan^{-1} \frac{v_{y_0}}{v_{x_0}}\)、速度\(\sqrt{v_{x_0}^2 + v_{y_0}^2}\)で石を投げた(\(x\)方向、\(y\)方向の速度成分がそれぞれ\((v_{x_0}\),\(v_{y_0})\))とする。この時の石の軌跡は、
\begin{eqnarray}
v_x & = & v_{x_0} \\
x_t & = & x_0 + \int_0^t v_x dt \\
v_{y_t} & = & v_{y_0} - \int_0^t g dt \\
y_t & = & y_0 + \int_0^t v_{y_t} dt \\
\end{eqnarray}
となる。なお、\((x_0,y_0)\)は石を投げた地点である。また、ここでは、石も鳥も\(x\)軸に沿って飛び、\(y\)軸は高さとする(\(z\)軸は観察者の深さ方向である)。
また、鳥は水平方向に等速度\(v'_{x_0}\)で飛んでいる。この時の軌跡は次のようになる。
\begin{eqnarray}
v'_x & = & v'_{x_0} \\
x'_t & = & x'_0 + \int_0^t v'_x dt \\
v'_y & = & 0 \\
y'_t & = & y'_0 \\
\end{eqnarray}
なお、\(x'_0\),\(y'_0\)は鳥が飛び出した地点である。
今、鳥が頭上から飛び出したとする。即ち、\(x_0=x'_0\)とする。また、石を投げた高さは簡単のために地表、即ち、\(y_0=0\)とする。この時、上の二つの運動方程式は次のようになる。
石:
\begin{eqnarray}
v_x & = & v_{x_0} \\
x_t & = & x_0 + \int_0^t v_x dt \\
v_{y_t} & = & v_{y_0} - \int_0^t g dt \\
y_t & = & \int_0^t v_{y_t} dt \\
\end{eqnarray}
鳥:
\begin{eqnarray}
v'_x & = & v'_{x_0} \\
x'_t & = & x_0 + \int_0^t v'_x dt \\
v'_y & = & 0 \\
y'_t & = & y'_0 \\
\end{eqnarray}
この時、石が鳥に当る必要条件は、水平方向の速度が一緒の時である。即ち、\(v_{x_0}=v'_{x_0}\)である。この時、運動方程式は次のようになる。
石:
\begin{eqnarray}
v_x & = & v_{x_0} \\
x_t & = & x_0 + \int_0^t v_x dt \\
v_{y_t} & = & v_{y_0} - \int_0^t g dt \\
y_t & = & \int_0^t v_{y_t} dt \\
\end{eqnarray}
鳥:
\begin{eqnarray}
v_x & = & v_{x_0} \\
x_t & = & x_0 + \int_0^t v_x dt \\
v'_y & = & 0 \\
y'_t & = & y'_0 \\
\end{eqnarray}
この時、石が鳥に当る時間は
\begin{eqnarray}
y'_0 & = & \int_0^t v_{y_t} dt \\
& = & v_{y_0} \times t - \frac {g \times t^2}{2} \\
\end{eqnarray}
となり、
\begin{eqnarray}
t & = & \frac { v_{y_0} \pm {\sqrt {v_{y_0}^2 - 2 \times g \times y'_0}}} {g} \\
\end{eqnarray}
となる。もっとも、石が鳥の飛んでいる高さまで届かない場合には問題にならない。即ち、速度が\(v_{y_0} \gt \sqrt {2 \times g \times y'_0}\)でないと鳥を落とすことはできない。
また、鳥が頭上ではなく、他の場所から飛び立ったときは、必要条件は旅人算で求められる。
それでは、プログラムを作成することにする。鳥の運動方程式をシグナル関数birdで次のように実装する。
bird :: Pos -> Vel -> SF () (Pos, Vel) bird pos0 vel0 = proc input -> do vel <- (vel0 ^+^) ^<< integral -< (0, 0) pos <- (pos0 ^+^) ^<< integral -< vel returnA -< (pos, vel)
また、シグナル関数bouncingBallの名前をthrowingStoneと変えておく。さらに、描画画面のタイトルもBounceからShooting Gameに変えておく。
次にsimulateを構成するシグナル関数updateに鳥の行動を組込む。これは次のようになる。
update :: SF () ((Pos, Vel), (Pos, Vel)) update = proc () -> do (pos1, vel1) <- throwingStone ((-8), 0) (4, 17) -< () (pos2, vel2) <- bird ((-8), 10) (4, 0) -< () returnA -< ((pos1, vel1), (pos2, vel2))
これに伴って、シグナル関数drawの型シグネチャも次のように変更する。
draw :: SF ((Pos, Vel), (Pos, Vel)) (IO ()) draw = arr clearAndRender
さらに、関数clearAndRenderに鳥の動きを描画するための式を組込む。clearAndRenderの変更部分は次のようになる。
clearAndRender :: ((Pos, Vel), (Pos, Vel)) -> IO () clearAndRender ((pos1, vel1), (pos2, vel2)) = do clear [ ColorBuffer, DepthBuffer ] loadIdentity renderPlayer $ vector3 (unsafeCoerce (fst pos1)) (unsafeCoerce (snd pos1)) (-30) renderPlayer $ vector3 (unsafeCoerce (fst pos2)) (unsafeCoerce (snd pos2)) (-30)
これらの修正を加えたプログラムの全体は次のようになる。
{-# LANGUAGE Arrows #-} import FRP.Yampa import Control.Concurrent import FRP.Yampa.Vector3 import FRP.Yampa.Utilities import Unsafe.Coerce import Data.IORef import Graphics.UI.GLUT hiding (Level,Vector3(..),normalize) import qualified Graphics.UI.GLUT as G(Vector3(..)) type Pos = (Double, Double) type Vel = (Double, Double) type R = GLdouble fallingBall :: Pos -> Vel -> SF () (Pos, Vel) fallingBall pos0 vel0 = proc input -> do vel <- (vel0 ^+^) ^<< integral -< (0, -9.81) pos <- (pos0 ^+^) ^<< integral -< vel returnA -< (pos, vel) throwingStone :: Pos -> Vel -> SF () (Pos, Vel) throwingStone pos0 vel0 = switch (bb pos0 vel0) (\ (pos, vel) -> if abs (snd vel) <= 1 then constant ((fst pos, 0), (0, 0)) else throwingStone pos ((fst vel), (- (snd vel)) * 0.6)) where bb pos0' vel0' = proc input -> do (pos, vel) <- fallingBall pos0' vel0' -< input event <- edge -< snd pos <= 0 returnA -< ((pos, vel), event `tag` (pos, vel)) bird :: Pos -> Vel -> SF () (Pos, Vel) bird pos0 vel0 = proc input -> do vel <- (vel0 ^+^) ^<< integral -< (0, 0) pos <- (pos0 ^+^) ^<< integral -< vel returnA -< (pos, vel) initGL :: IO () initGL = do getArgsAndInitialize createWindow "Shooting Game" initialDisplayMode $= [ WithDepthBuffer, DoubleBuffered ] depthFunc $= Just Less clearColor $= Color4 0 0 0 0 light (Light 0) $= Enabled lighting $= Enabled lightModelAmbient $= Color4 0.5 0.5 0.5 1 diffuse (Light 0) $= Color4 1 1 1 1 blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse) reshapeCallback $= Just resizeScene return () resizeScene :: Size -> IO () resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero resizeScene s@(Size width height) = do -- putStrLn "resizeScene" viewport $= (Position 0 0, s) matrixMode $= Projection loadIdentity perspective 45 (w2/h2) 1 1000 matrixMode $= Modelview 0 where w2 = half width h2 = half height half z = realToFrac z / 2 clearAndRender :: ((Pos, Vel), (Pos, Vel)) -> IO () clearAndRender ((pos1, vel1), (pos2, vel2)) = do clear [ ColorBuffer, DepthBuffer ] loadIdentity renderPlayer $ vector3 (unsafeCoerce (fst pos1)) (unsafeCoerce (snd pos1)) (-30) renderPlayer $ vector3 (unsafeCoerce (fst pos2)) (unsafeCoerce (snd pos2)) (-30) flush where size2 :: R size2 = (fromInteger $ 6)/2 green = Color4 0.8 1.0 0.7 0.9 :: Color4 R greenG = Color4 0.8 1.0 0.7 1.0 :: Color4 R red = Color4 1.0 0.7 0.8 1.0 :: Color4 R renderShapeAt s p = preservingMatrix $ do translate $ G.Vector3 (0.5 - size2 + vector3X p) (0.5 - size2 + vector3Y p) (0.5 - size2 + vector3Z p) renderObject Solid s renderObstacle = (color green >>) . (renderShapeAt $ Cube 1) renderPlayer = (color red >>) . (renderShapeAt $ Sphere' 0.5 20 20) renderGoal = (color greenG >>) . (renderShapeAt $ Sphere' 0.5 20 20) main :: IO () main = do oldTime <- newIORef (0 :: Int) rh <- reactInit (initGL >> return NoEvent) (\_ _ b -> b >> return False) simulate displayCallback $= return () idleCallback $= Just (idle oldTime rh) oldTime' <- get elapsedTime writeIORef oldTime oldTime' mainLoop idle :: IORef Int -> ReactHandle (Event ()) (IO ()) -> IO () idle oldTime rh = do newTime' <- get elapsedTime oldTime' <- get oldTime let dt = (fromIntegral $ newTime' - oldTime')/1000 react rh (dt, Nothing) writeIORef oldTime newTime' return () simulate :: SF (Event ()) (IO ()) simulate = discardInputs >>> update >>> draw discardInputs :: SF (Event ()) () discardInputs = arr $ const () update :: SF () ((Pos, Vel), (Pos, Vel)) update = proc () -> do (pos1, vel1) <- throwingStone ((-8), 0) (4, 17) -< () (pos2, vel2) <- bird ((-8), 10) (4, 0) -< () returnA -< ((pos1, vel1), (pos2, vel2)) draw :: SF ((Pos, Vel), (Pos, Vel)) (IO ()) draw = arr clearAndRender
上記のプログラムで、石を地点(-8,0)から速度(4,17)で投げる。鳥は、地点(-8,10)から速度(4,0)で飛び立つ。なお、単位は、\(m\), \(m/sec\)である。このプログラムを実行すると、石と鳥が交錯するのが分かる。
なお、石や鳥の色を変えるなど、画面を見やすくしたいのであれば、跳ね返るボールのプログラムを参考にするとよい。