Netwireでゲームを作成する（１０）

１３．ボックスを動かす

ここでは、四角いボックスを左右に動かす単純なゲームの作成方法について記述する。

ゲームは時間とともに進行していく。Netwireでゲームに登場してくるものの振舞いは、Wire型の値で定められている。ゲームが進行する中で、値が変化し、様々な場面を作り出してくれる。Netwireでは、ゲームは微小な時間dtを単位に進められる。最初に開始場面が作成され、その次に、dt経過した後の場面が作成される。さらに、dt経過後の場面へとこの処理が繰り返される。

Wire型の値は、ある時間が経過したときの振舞いの変化をstepWireで定めている。stepWireの考え方は、stepBehaviorでこれまで説明してきたものと同じである。型シグネチャは次のようになっている。

stepWire :: Monad m => Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b) 

stepWireから、現在のWire型の値wireから、次の値wire'を得ることができる。但し、次の値は、経過した時間（s）とイベントなどの入力(Either e a)に依存する。また、次の値とともに出力(Either e b)を得る。出力は値があるときはbをそうでないときは抑制値eを出力する。但し、出力と次の値の対は(Either e b, Wire s e m a b)はモナドm型に属している。

そこで、stepWireを繰り返し実行することで、振舞いの変化を見ることができる。そのプログラムは次のようになる。

 loop wire = do
     dt <- timeDeltaToLastInstant
     (wt', wire') <- stepWire wire dt ()
     case wt' of
       Left ex -> printf "Inhibited: %s\n" (show ex)
       Right x -> printf "Produced: %s\n" (show x)
     loop wire'

上記のプログラムで、(wt', wire')が出力と次の値の対である。また、アロー記法であることに注意してほしい。このため、(wt', wire')はモナドm型ではない。wt'は型引数eまたはbであり、wire'はWire型である。

また、微小な時間は、システムが用意しているstepSessionを利用すると便利である。

loop session wire = do
    (dt, session') <- stepSession session
    (wt', wire') <- stepWire wire dt ()
    case wt' of
      Left ex -> printf "Inhibited: %s\n" (show ex)
      Right x -> printf "Produced: %s\n" (show x)
    loop session' wire'

前回の記事で、キーA,Dを押すことで、等速で左右に移動するWire型の値posを得た。

四角いボックスの（左下の）位置をこのposで表すことにすれば、posの変化とともに、四角いボックスが動くことになる。四角いボックスは正方形とし、一辺の長さを0.05とし、y座標は常に0とする。

描写はOpenGLで行う。四角いボックスの頂点はgeneratePointsで作成し、頂点はrenderPointでレンダーする。

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) ] 

これを用いると、四角いボックスの振舞いを次のように表せる。なお、ここでは、loopがrunNetworkとなっている。

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' 

これを描画に必要な枠組みの中に挿入することでプログラムは完成である。なお、runNetworkの型引数sessionとwireはclockSession_とposにする。

main :: IO () 
main = do
  initialize 
  openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
 
  closedRef <- newIORef False 
  windowCloseCallback $= do 
    writeIORef closedRef True 
    return True 
  runNetwork closedRef clockSession_ pos 
  closeWindow 

実行の様子を示したのが次のビデオである。

プログラム全体を示すと以下のようになる。

import Graphics.Rendering.OpenGL 
import Graphics.UI.GLFW 
import Data.IORef 
import Prelude hiding ((.)) -- To use (.) in the scope of Categories instead
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     --mempty: モノイドの単位元
    Release -> Left mempty 
speed :: Monoid e => Wire s e IO a Double 
speed = pure ( 0.0) . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D') 
      <|> pure (-0.5) . isKeyDown (CharKey 'A') 
      <|> pure ( 0.5) . isKeyDown (CharKey 'D') 
      <|> pure ( 0.0) 
pos :: HasTime t s => Wire s () IO a Double 
pos = integral 0 . speed


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 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
 
  closedRef <- newIORef False 
  windowCloseCallback $= do 
    writeIORef closedRef True 
    return True 
  runNetwork closedRef clockSession_ pos 
  closeWindow