diff options
Diffstat (limited to 'src/World')
| -rw-r--r-- | src/World/Lattice.hs | 34 |
1 files changed, 25 insertions, 9 deletions
diff --git a/src/World/Lattice.hs b/src/World/Lattice.hs index d377792..587a8cb 100644 --- a/src/World/Lattice.hs +++ b/src/World/Lattice.hs @@ -8,21 +8,27 @@ module World.Lattice import World.Types - (Combinable (..) - , LatticeProposal (..) + ( Combinable (..) + , LatticeProposal (LatticeProposal) , LatticePropList (..) ) -data LatticeCell a b = LatticeCell { kind :: a, flags :: b } deriving (Show, Eq) +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 @@ -31,25 +37,35 @@ updateLattice lattice rules = in map mapRow (zip lattice [0..]) -applyLatticeProposals :: (Combinable b) => Lattice a b -> LatticePropList a b -> Lattice a b +-- 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) - applyProp l (LatticeProposal (x, y) from to flags) = + + -- 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 flags $ cellFlags cell) + cell' = LatticeCell to (combine flgs (cellFlags cell)) in - update l y (update row x cell') + 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 { flags = identity } ) + (\cell -> cell { cellFlags = identity } ) row ) lattice in - foldl applyProp lattice' props + -- apply each proposal to the lattice' + foldl (applyProp) lattice' props |