pad.hs

{-# LANGUAGE DeriveFunctor, FlexibleInstances, RecordWildCards, TupleSections #-}

import Control.Comonad
import Data.Array

data Board a = Board {focus :: (Int,Int), cells :: Array (Int, Int) a} deriving (Functor)

xsize = 167
ysize = 42
rng = ((0,0),(xsize-1,ysize-1))

instance Comonad Board where
    extract (Board {..}) = cells ! focus
    extend wab (Board {..}) = Board focus $ array rng [(newfocus, wab $ Board newfocus cells) | newfocus <- range rng]

at (Board (fx, fy) cells) (x,y) = cells ! (mod(x+fx)xsize, mod(y+fy)ysize)

type Conway = Board Bool

instance Show Conway where
    show b = unlines [[if b `at` (x,y) then '*' else '-' | x <- [0..xsize-1]] | y <- [0..ysize-1]]

step :: Conway -> Conway
step = case [(x,y) | x <- [0,-1,1], y <- [0,-1,1]] of
        (origin:neighbors) -> extend $ \b -> let living = length $ filter (b `at`) neighbors in
            if b `at` origin
               then living == 2 || living == 3
               else living == 3

shift pt = extend (`at` pt)
fromPts = Board (xsize `div` 2, ysize `div` 2) . accumArray (||) False rng . fmap (,True)

acorn = fromPts [(0,0),(1,0),(1,2),(3,1),(4,0),(5,0),(6,0)]