From 15a0b3d4658faced5e5e09c582f4c22365b31ad7 Mon Sep 17 00:00:00 2001
From: sanine <sanine.not@pm.me>
Date: Tue, 5 Dec 2023 12:50:56 -0600
Subject: begin implementing applyLatticeProposals

---
 src/World/Lattice.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

(limited to 'src/World')

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
-- 
cgit v1.2.1