bitterharvest’s diary

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

シューティングゲーム手習い:鳥も参加

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\)である。このプログラムを実行すると、石と鳥が交錯するのが分かる。

なお、石や鳥の色を変えるなど、画面を見やすくしたいのであれば、跳ね返るボールのプログラムを参考にするとよい。