diff options
Diffstat (limited to 'src/World/Lattice.hs')
| -rw-r--r-- | src/World/Lattice.hs | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/src/World/Lattice.hs b/src/World/Lattice.hs index 257ea50..d377792 100644 --- a/src/World/Lattice.hs +++ b/src/World/Lattice.hs @@ -3,9 +3,17 @@ module World.Lattice , Lattice , LatticeRule , updateLattice + , applyLatticeProposals ) where +import World.Types + (Combinable (..) + , LatticeProposal (..) + , LatticePropList (..) + ) + + data LatticeCell a b = LatticeCell { kind :: a, flags :: b } deriving (Show, Eq) type Lattice a b = [[LatticeCell a b]] type LatticeRule a b = Lattice a b -> Int -> Int -> LatticeCell a b @@ -21,3 +29,27 @@ updateLattice lattice rules = ) (zip row [0..]) in map mapRow (zip lattice [0..]) + + +applyLatticeProposals :: (Combinable b) => Lattice a b -> LatticePropList a b -> Lattice a b +applyLatticeProposals lattice (LatticePropList props) = + let + update list idx new = + let (front, _:back) = splitAt idx list in front ++ (new:back) + applyProp l (LatticeProposal (x, y) from to flags) = + let + row = l !! y + cell = row !! x + cell' = LatticeCell to (combine flags $ cellFlags cell) + in + update l y (update row x cell') + + -- replace each cell's flags with the identity + lattice' = map + (\row -> map + (\cell -> cell { flags = identity } ) + row + ) + lattice + in + foldl applyProp lattice' props |