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

bitterharvest’s diary

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

YampaとOpenGL(GLUT)で簡単なシューティングゲームを作成する―付録

1.データ型

シューティングゲームの主要な部分の説明は終わったので、ここでは、このゲームのために定義したデータ型やタイプを説明する。

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

module Types where

import FRP.Yampa

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

type Input = ()

type Logic = Event ()
     
data ObjEvents = ObjEvents
  { oeInput :: Input,
    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

この中で、データ型ObjEventsは発生したイベントを記憶するときに使用する。レコード構文になっていて、oeInputは入力デバイスからのイベントを、oeLogicは登場者間での干渉により発生したイベントを記憶する。

データ型ObjOutputは、サイクル終了時に出力される登場者状態を記憶するためのもので、やはり、レコード構文になっている。ooKindは登場者の種類(石や鳥)、ooStateは登場者の位置と速度、ooKillRequestは登場者の退場、ooSpawnRequestsは登場者の登場を表すフィールドである。

defaultObjOutputはObjOutputのインスタンスである。

2.識別リスト

識別リストは、Yampaを用いて作成されたスペースインベーダで定義されているものをそのまま用いた。プログラムは次のようになっている。

module IdentityList (
    ILKey,        -- Identity-list key type
    IL,           -- Identity-list, abstract. Instance of functor.
    emptyIL,      -- :: IL a
    insertIL_,    -- :: a -> IL a -> IL a
    insertIL,     -- :: a -> IL a -> (ILKey, IL a)
    listToIL,     -- :: [a] -> IL a
    keysIL,       -- :: IL a -> [ILKey]
    elemsIL,      -- :: IL a -> [a]
    assocsIL,     -- :: IL a -> [(ILKey, a)]
    deleteIL,     -- :: ILKey -> IL a -> IL a
    mapIL,        -- :: ((ILKey, a) -> b) -> IL a -> IL b
    filterIL,     -- :: ((ILKey, a) -> Bool) -> IL a -> IL a
    mapFilterIL,  -- :: ((ILKey, a) -> Maybe b) -> IL a -> IL b
    lookupIL,     -- :: ILKey -> IL a -> Maybe a
    findIL,       -- :: ((ILKey, a) -> Bool) -> IL a -> Maybe a
    mapFindIL,    -- :: ((ILKey, a) -> Maybe b) -> IL a -> Maybe b
    findAllIL,    -- :: ((ILKey, a) -> Bool) -> IL a -> [a]
    mapFindAllIL  -- :: ((ILKey, a) -> Maybe b) -> IL a -> [b]
) where

------------------------------------------------------------------------------
-- Data type definitions
------------------------------------------------------------------------------

type ILKey = Int

-- Invariants:
-- * Sorted in descending key order. (We don't worry about
--   key wrap around).
-- * Keys are NOT reused
data IL a = IL { ilNextKey :: ILKey, ilAssocs :: [(ILKey, a)] }


------------------------------------------------------------------------------
-- Class instances
------------------------------------------------------------------------------

instance Functor IL where
    fmap f (IL {ilNextKey = nk, ilAssocs = kas}) =
        IL {ilNextKey = nk, ilAssocs = [ (i, f a) | (i, a) <- kas ]}


------------------------------------------------------------------------------
-- Constructors
------------------------------------------------------------------------------

emptyIL :: IL a
emptyIL = IL {ilNextKey = 0, ilAssocs = []}


insertIL_ :: a -> IL a -> IL a
insertIL_ a il = snd (insertIL a il)


insertIL :: a -> IL a -> (ILKey, IL a)
insertIL a (IL {ilNextKey = k, ilAssocs = kas}) = (k, il') where
    il' = IL {ilNextKey = k + 1, ilAssocs = (k, a) : kas}


listToIL :: [a] -> IL a
listToIL as = IL {ilNextKey = length as,
                  ilAssocs = reverse (zip [0..] as)} -- Maintain invariant!


------------------------------------------------------------------------------
-- Additional selectors
------------------------------------------------------------------------------

assocsIL :: IL a -> [(ILKey, a)]
assocsIL = ilAssocs


keysIL :: IL a -> [ILKey]
keysIL = map fst . ilAssocs


elemsIL :: IL a -> [a]
elemsIL = map snd . ilAssocs


------------------------------------------------------------------------------
-- Mutators
------------------------------------------------------------------------------

deleteIL :: ILKey -> IL a -> IL a
deleteIL k (IL {ilNextKey = nk, ilAssocs = kas}) =
    IL {ilNextKey = nk, ilAssocs = deleteHlp kas}
    where
        deleteHlp []                                   = []
        deleteHlp kakas@(ka@(k', _) : kas) | k > k'    = kakas
                                           | k == k'   = kas
                                           | otherwise = ka : deleteHlp kas


------------------------------------------------------------------------------
-- Filter and map operations
------------------------------------------------------------------------------

-- These are "identity-preserving", i.e. the key associated with an element
-- in the result is the same as the key of the element from which the
-- result element was derived.

mapIL :: ((ILKey, a) -> b) -> IL a -> IL b
mapIL f (IL {ilNextKey = nk, ilAssocs = kas}) =
    IL {ilNextKey = nk, ilAssocs = [(k, f ka) | ka@(k,_) <- kas]}


filterIL :: ((ILKey, a) -> Bool) -> IL a -> IL a
filterIL p (IL {ilNextKey = nk, ilAssocs = kas}) =
    IL {ilNextKey = nk, ilAssocs = filter p kas}


mapFilterIL :: ((ILKey, a) -> Maybe b) -> IL a -> IL b
mapFilterIL p (IL {ilNextKey = nk, ilAssocs = kas}) =
    IL {
        ilNextKey = nk,
        ilAssocs = [(k, b) | ka@(k, _) <- kas, Just b <- [p ka]]
    }


------------------------------------------------------------------------------
-- Lookup operations
------------------------------------------------------------------------------

lookupIL :: ILKey -> IL a -> Maybe a
lookupIL k il = lookup k (ilAssocs il)


findIL :: ((ILKey, a) -> Bool) -> IL a -> Maybe a
findIL p (IL {ilAssocs = kas}) = findHlp kas
    where
        findHlp []                = Nothing
        findHlp (ka@(_, a) : kas) = if p ka then Just a else findHlp kas


mapFindIL :: ((ILKey, a) -> Maybe b) -> IL a -> Maybe b
mapFindIL p (IL {ilAssocs = kas}) = mapFindHlp kas
    where
        mapFindHlp []         = Nothing
        mapFindHlp (ka : kas) = case p ka of
                                    Nothing     -> mapFindHlp kas
                                    jb@(Just _) -> jb


findAllIL :: ((ILKey, a) -> Bool) -> IL a -> [a]
findAllIL p (IL {ilAssocs = kas}) = [ a | ka@(_, a) <- kas, p ka ]


mapFindAllIL:: ((ILKey, a) -> Maybe b) -> IL a -> [b]
mapFindAllIL p (IL {ilAssocs = kas}) = [ b | ka <- kas, Just b <- [p ka] ]