1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
module World.Lattice
( LatticeCell (..)
, Lattice
, LatticeRule
, updateLattice
, applyLatticeProposals
) where
import World.Types
( Combinable (..)
, LatticeProposal (LatticeProposal)
, LatticePropList (..)
)
data LatticeCell a b = LatticeCell { kind :: a, cellFlags :: b } deriving (Show, Eq)
type Lattice a b = [[LatticeCell a b]]
type LatticeRule a b = Lattice a b -> Int -> Int -> LatticeCell a b
-- apply update rules to a lattice
-- each rule is specific to a cell kind. it should
-- take a lattice, an X-coordinate, and a Y-coordinate, and
-- return a new LatticeCell
updateLattice :: (Enum a) => Lattice a b -> [LatticeRule a b] -> Lattice a b
updateLattice lattice rules =
let
-- map across each row in the lattice
mapRow = \(row, y) -> map
-- map each cell to its new state, based on the relevant rule
(\((LatticeCell k _), x) ->
let rule = rules !! (fromEnum k)
in rule lattice x y
)
(zip row [0..])
in map mapRow (zip lattice [0..])
-- apply proposals to a lattice
-- during preprocessing, each cell's `flags` field is replaced by
-- its Combinable identity. postprocessing rules should be used to
-- restore any "persistent" flags.
applyLatticeProposals :: (Eq a, Combinable b) => Lattice a b -> LatticePropList a b -> Lattice a b
applyLatticeProposals lattice (LatticePropList props) =
let
-- helper: replace single element in a list
update list idx new =
let (front, _:back) = splitAt idx list in front ++ (new:back)
-- apply a single proposal to the lattice
applyProp l (LatticeProposal (x, y) from to flgs) =
let
row = l !! y
cell = row !! x
cell' = LatticeCell to (combine flgs (cellFlags cell))
in
if kind ((lattice !! y) !! x) == from -- check against original lattice, as kind may have been changed by other proposals c:
then update l y (update row x cell')
else l -- invalid proposal, don't change anything
-- replace each cell's flags with the identity
lattice' = map
(\row -> map
(\cell -> cell { cellFlags = identity } )
row
)
lattice
in
-- apply each proposal to the lattice'
foldl (applyProp) lattice' props
|
