YampaとOpenGL(GLUT)で簡単なシューティングゲームを作成する―発射と停止を加える（１）

１．概略

これまで述べてきたゲームは、本当に基本的な部分を製作しただけで、勝手に鳥が飛んで、勝手に石が飛んで行って、鳥を撃ち落としていた。今回、紹介する記事は、この部分は変わらないのだが、キーボードから石の発射や石と鳥の停止を指示できるようにする。これにより、キーボードの使い方がわかる。

ここでは、PgUpキーを石の発射に、PgDnキーを石と鳥の停止にする。

２．インプット

キーボードからの入力があったかどうかを検知するプログラムを準備する。このプログラムはキーボードが押し下げられたかを検知する信号関数(filterKeyDowns)と、どのキーが押されたかを検する信号関数(parseInput)を用意する。なお、parseInputでは上下左右のキーが押されたことを検知する。他のキーについてはこれと同じように定義すればよい。プログラムは以下の通りとなる。

{-# LANGUAGE Arrows #-}
module Input (parseInput) where

import FRP.Yampa

import Graphics.UI.GLUT

import Types

filterKeyDowns :: SF (Event Input) (Event Input)
filterKeyDowns = arr $ filterE ((==Down) . keyState)
                       
parseInput :: SF (Event Input) ParsedInput
parseInput = proc i -> do
    down <- filterKeyDowns                  -< i
    uEvs <- filterKey (SpecialKey KeyUp)    -< down
    dEvs <- filterKey (SpecialKey KeyDown)  -< down
    rEvs <- filterKey (SpecialKey KeyRight) -< down
    lEvs <- filterKey (SpecialKey KeyLeft)  -< down
    returnA -< ParsedInput uEvs dEvs rEvs lEvs
    where filterKey k = arr $ filterE ((==k) . key)

３．メインのプログラム

mainのプログラムは、キーボードとマウスからのコールバックを付け加えればよい。このコールバックは次のようになっている。

    keyboardMouseCallback $= Just 
        (\k ks m _ -> writeIORef newInput (Event $ Keyboard k ks m))

また、mainSFのところでは、キーボードからの入力があるかどうかを検知するために、最初にparseInputを行う。これは、先ほどのインプットのところで紹介した信号関数である。

従って、mainのプログラムの全体は次のようになる。

module Main where

import FRP.Yampa

import Data.IORef
import Graphics.UI.GLUT

import Graphics
import Process
import IdentityList
import Objects
import Types
import Input

mainSF :: SF (Event Input) (IO ())
mainSF = parseInput >>> process objs >>^  \ oos -> draw oos
  where
    stone1Obj = stoneObject (-8, 0)  (1, 15)
    stone2Obj = stoneObject (-8, 0)  (4, 17)
    birdObj   = birdObject  (-8, 10) (4, 0)
    objs      = listToIL [stone1Obj, stone2Obj, birdObj]


main :: IO ()
main = do
    newInput <- newIORef NoEvent
    oldTime <- newIORef (0 :: Int)
    rh <- reactInit (initGL >> return NoEvent) (\_ _ b -> b >> return False) 
                    mainSF
    displayCallback $= return ()
    keyboardMouseCallback $= Just 
        (\k ks m _ -> writeIORef newInput (Event $ Keyboard k ks m))
    idleCallback $= Just (idle newInput oldTime rh)
    oldTime' <- get elapsedTime
    writeIORef oldTime oldTime' 
    mainLoop

idle :: IORef (Event Input) -> IORef Int -> 
        ReactHandle (Event Input) (IO ()) -> IO ()
idle newInput oldTime rh = do
    newInput' <- readIORef newInput
    newTime'  <- get elapsedTime
    oldTime'  <- get oldTime
    let dt = fromIntegral (newTime' - oldTime') / 1000
    _ <- react rh (dt, Just newInput')
    writeIORef oldTime newTime'
    return ()

４．プロセスのプログラム

プロセスのプログラムでは、キーボードからのイベントの登録とイベント発生にに伴う処理を加える。関数routeの中でrouteAuxを紹介したが、その中にoeInput = inputというのがある。これにより、レコードObjEventsのフィールドoeInputにキーボードからのイベントを登録する。また、PgDnキーが押された時は識別リストを空にする。これは次のようになる。

  if isEvent (downEvs input)
    then Event (\_ -> emptyIL)

従って。プロセスのプログラムは次のようになる。

{-# LANGUAGE Arrows #-}
module Process where

import FRP.Yampa

import IdentityList
import Types

process :: IL Object -> SF ParsedInput (IL ObjOutput)
process objs0 = proc input -> do
  rec
    oos <- core objs0 -< (input, oos)
  returnA -< oos

core :: IL Object -> SF (ParsedInput, IL ObjOutput) (IL ObjOutput)
core objs = dpSwitch 
  route
  objs
  (arr killAndSpawn >>> notYet)
  (\sfs' f -> core (f sfs'))

route :: (ParsedInput, IL ObjOutput) -> IL sf -> IL (ObjEvents, sf)
route (input, oos) objs = mapIL routeAux objs
  where
    hs = hits (assocsIL (fmap ooState oos)) -- process all object 'State's
    routeAux (k, obj) = (ObjEvents
      { oeInput = input,
        oeLogic = if k `elem` hs then Event () else NoEvent
      }, obj)

hits :: [(ILKey, State)] -> [ILKey]
hits kooss = concat (hitsAux kooss)
  where
    hitsAux [] = []
    -- Check each object 'State' against each other
    hitsAux ((k,oos):kooss') =
        [ [k, k'] | (k', oos') <- kooss', oos `hit` oos' ]
        ++ hitsAux kooss'

    hit :: State -> State -> Bool
    hit state1 state2 = dis2 (position' state1) (position' state2) < 0.1
    dis2 (x1, y1) (x2, y2) = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)

killAndSpawn :: ((ParsedInput, IL ObjOutput), IL ObjOutput)
             -> Event (IL Object -> IL Object)
killAndSpawn ((input, _), oos) =
  if isEvent (downEvs input)
    then Event (\_ -> emptyIL) 
  else foldl (mergeBy (.)) noEvent events
  where
    events :: [Event (IL Object -> IL Object)]
    events = [ mergeBy (.)
                      (ooKillRequest oo `tag` (deleteIL k))
                      (fmap  (foldl (.) id . map insertIL_)
                             (ooSpawnRequests oo))
             | (k, oo) <- assocsIL oos ]

５．データ型指定のプログラム

データ型を指定するObjectsのプログラムでは、キーボードの状態を有するInputと、キーボードで発生したイベントを有するParsesInputをレコード構文を用いて用意する。プログラムの全体は以下のとおりである。

import FRP.Yampa
import Graphics.UI.GLUT

type Pos = (Double, Double)
type Vel = (Double, Double)

type Logic = Event ()
     
data ObjEvents = ObjEvents
  { oeInput :: ParsedInput,
    oeLogic :: Logic
  } --deriving (Show)

data State = State {position' :: Pos, velocity :: Vel}
  deriving (Show)

data ObjOutput = ObjOutput
  { ooKind          :: ObjectKind,
    ooState         :: State,
    ooKillRequest   :: Event (),
    ooSpawnRequests :: Event [Types.Object]
  }

defaultObjOutput :: ObjOutput
defaultObjOutput = ObjOutput
  { ooKind          = undefined,
    ooState         = undefined,
    ooKillRequest   = NoEvent,
    ooSpawnRequests = NoEvent
  }

data ObjectKind = Stone | Bird deriving (Eq, Ord, Show)

type Object = SF ObjEvents ObjOutput

data Input = Keyboard { key       :: Key,
                        keyState  :: KeyState,
                        modifiers :: Modifiers }

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

次の記事では、鳥や石の信号関数がどのように定義したらよいかを説明する。