Выбрать главу

ного значения мы попробуем создать новый шар.

Перейдём к грязным данным. Там мы будем хранить информацию, необходимую для обновления модели

в 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