読者です 読者をやめる 読者になる 読者になる

bitterharvest’s diary

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

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

1.概略

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

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

2.インプット

キーボードからの入力があったかどうかを検知するプログラムを準備する。このプログラムはキーボードが押し下げられたかを検知する信号関数(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)

3.メインのプログラム

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

4.プロセスのプログラム

プロセスのプログラムでは、キーボードからのイベントの登録とイベント発生にに伴う処理を加える。関数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 ]

5.データ型指定のプログラム

データ型を指定する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 }

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