ного значения мы попробуем создать новый шар.
Перейдём к грязным данным. Там мы будем хранить информацию, необходимую для обновления модели
в Hipmunk, и значение, в которое GLFW будет записывать состояние мыши, также мы будем следить за тем,
кто столкнулся с шаром игрока в данный момент:
data Dirty = Dirty
{ dirtyHero
:: Obj
, dirtyObjs
:: IxMap Obj
, dirtySpace
:: H.Space
, dirtyTouchVar :: Sensor H.Shape
, dirtyMouse
:: Sensor H.Position
}
data Obj = Obj
{ objType
:: BallType
, objShape
:: H.Shape
, objBody
:: H.Body
}
type Sensor a = IORef (Maybe a)
Особая структура IxMap отвечает за хранение значений вместе с индексами. Пока остановимся на самом
простом представлении:
type IxMap a = [(Id, a)]
20.4 Структура проекта
Наметим структуру проекта. У нас уже есть модуль Types. hs. Основной цикл игры будет описан в модуле
Loop. hs. Общие функции обновления состояния будут определены в World. hs, также у нас будет два модуля
отвечающие за обновление чистых и грязных данных – Pure. hs и Dirty. hs. Мы выделим отдельный модуль
для описания всех констант игры (Inits. hs). Так нам будет удобно настроить игру, когда мы закончим с
кодом. Отдельный модуль Utils будет содержать все функции общего назначения, преобразования между
типами OpenGL и Hipmunk.
302 | Глава 20: Императивное программирование
20.5 Детализируем функции обновления состояния игры
Начнём с восприятия:
module World where
import qualified Physics.Hipmunk as H
import Data.Maybe
import Types
import Utils
import Pure
import Dirty
percept :: Dirty -> IO (Sense, [Event])
percept a = do
hero
<- obj2hero $ dirtyHero a
balls
<- mapM (uncurry obj2ball) $ setIds dirtyObjs a
evts1
<- fmap maybeToList $ getTouch (dirtyTouchVar a) $ dirtyObjs a
evts2
<- fmap maybeToList $ getClick $ dirtyMouse a
return $ (Sense hero balls, evts1 ++ evts2)
where setIds = zip [0.. ]
-- в Dirty.hs
obj2hero
:: Obj -> IO HeroBall
obj2ball
:: Id -> Obj -> IO Ball
getTouch
:: Sensor H.Shape -> IxMap Obj -> IO (Maybe Event)
getClick
:: Sensor H.Position -> IO (Maybe Event)
Далее мы не будем каждый раз выписывать новые неопределённые функции, мы будем просто оставлять
объявления типов без определений. Итак мы написали одну функцию, и получили ещё четыре новых.
Мы сделаем предположение о том, что сначала мы реагируем на непрерывные события, а затем на дис-
кретные. Причём к запросам на реакции могут привести только дискретные события:
updatePure :: Sense -> [Event] -> Pure -> (Pure, [Query])
updatePure s evts = updateEvents evts . updateSenses s
-- в Pure.hs
updateSenses :: Sense -> Pure -> Pure
updateEvents :: [Event] -> Pure -> (Pure, [Query])
В функции react мы предполагаем, что реакции мира на события независимы друг от друга. foldQuery~–
функция свёртки для типа Query.
import Control.Monad
...
react :: [Query] -> Dirty -> IO Dirty
react = foldr (<=< ) return
. fmap (foldQuery removeBall heroVelocity makeBall)
-- в Dirty.hs
removeBall
:: Ball
-> Dirty -> IO Dirty
heroVelocity
:: H.Velocity
-> Dirty -> IO Dirty
makeBall
:: Freq
-> Dirty -> IO Dirty
Обратите внимание на то, как мы воспользовались функциями foldr, return и <=< для того чтобы нани-
зать друг на друга функции типа Dirty -> IO Dirty. Напомню, что функция <=< ~– это аналог композиции
для монадных функций.
Обновление модели:
updateDirty :: Dirty -> IO Dirty
updateDirty = stepDirty dt
-- в Dirty.hs
Детализируем функции обновления состояния игры | 303
stepDirty :: H.Time -> Dirty -> IO Dirty
-- в Inits.hs
dt :: H.Time
dt = 0.5
Функции рисования поместим в отдельный модуль Graphics. hs
-- переместим из Loop.hs в World.hs
drawWorld :: World -> IO ()
drawWorld = draw . picture . worldPure
-- в Graphics.hs
draw :: Picture -> IO ()
-- в Pure.hs
picture
:: Pure -> Picture
Добавим функцию инициализации игры:
initWorld :: IO World
initWorld = do
dirty
<- initDirty
(sense, events) <- percept dirty
return $ World (initPure sense events) dirty
-- в Dirty.hs
initDirty :: IO Dirty