begin implementing applyLatticeProposals

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