2021-12-20 15:23:12 -05:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
|
|
|
|
module GOL.Engine where
|
|
|
|
|
|
|
|
import Control.Comonad.Env
|
2021-12-21 22:05:08 -05:00
|
|
|
import Control.Comonad.Identity (Identity (Identity))
|
2021-12-20 15:23:12 -05:00
|
|
|
import Control.Comonad.Representable.Store
|
|
|
|
import Data.Bool (bool)
|
2021-12-21 22:05:08 -05:00
|
|
|
import Data.Functor.Rep
|
2021-12-20 15:23:12 -05:00
|
|
|
import GOL.Rule
|
|
|
|
import GOL.Space
|
|
|
|
|
2021-12-20 16:20:51 -05:00
|
|
|
-- | The comonad stack used in the Game of Life engine.
|
|
|
|
-- It consists of a store comonad over the space @f@,
|
|
|
|
-- with an environment containing a rule.
|
2021-12-20 15:23:12 -05:00
|
|
|
type GOL f = EnvT Rule (Store f)
|
|
|
|
|
2021-12-21 22:05:08 -05:00
|
|
|
-- | Construct a 'GOL' value given a rule, a board
|
|
|
|
-- state, and an initial position.
|
|
|
|
gol :: Rule -> Rep f -> f a -> GOL f a
|
|
|
|
gol r p s = EnvT r $ StoreT (Identity s) p
|
|
|
|
|
|
|
|
-- | Construct a 'GOL' value on a displayable space,
|
|
|
|
-- defaulting to an initial position of @(0, 0)@.
|
|
|
|
gol' :: DisplayableSpace f => Rule -> f a -> GOL f a
|
|
|
|
gol' r = gol r (0,0)
|
|
|
|
|
2021-12-26 19:41:32 -05:00
|
|
|
|
|
|
|
|
2021-12-20 15:28:11 -05:00
|
|
|
getNeighbors :: forall f a. Space f => GOL f a -> [a]
|
|
|
|
getNeighbors = experiment $ neighbors @f
|
2021-12-20 15:26:18 -05:00
|
|
|
|
2021-12-20 15:28:11 -05:00
|
|
|
nextState :: Space f => GOL f Bool -> Bool
|
2021-12-20 15:26:18 -05:00
|
|
|
nextState = do
|
|
|
|
neighborStates <- getNeighbors
|
|
|
|
let count = sum . fmap (bool 0 1) $ neighborStates
|
|
|
|
|
2021-12-20 16:20:51 -05:00
|
|
|
selfState <- extract
|
|
|
|
Rule survive birth <- ask
|
|
|
|
return $
|
|
|
|
if selfState
|
|
|
|
then survive count
|
|
|
|
else birth count
|
2021-12-20 15:26:18 -05:00
|
|
|
|
2021-12-20 15:28:11 -05:00
|
|
|
tick :: Space f => GOL f Bool -> GOL f Bool
|
2021-12-20 15:26:18 -05:00
|
|
|
tick = extend nextState
|