From 587cbadb3e6388c29454ab41c120757f108918fa Mon Sep 17 00:00:00 2001
From: sanine <sanine.not@pm.me>
Date: Wed, 29 Nov 2023 20:48:46 -0600
Subject: implement updateLattice

---
 nerine.cabal        |  2 ++
 src/Lattice.hs      | 23 +++++++++++++++++++++++
 test/LatticeTest.hs | 37 +++++++++++++++++++++++++++++++++++++
 test/Main.hs        |  2 ++
 4 files changed, 64 insertions(+)
 create mode 100644 src/Lattice.hs
 create mode 100644 test/LatticeTest.hs

diff --git a/nerine.cabal b/nerine.cabal
index 7592604..0e1695a 100644
--- a/nerine.cabal
+++ b/nerine.cabal
@@ -26,6 +26,7 @@ source-repository head
 library
   exposed-modules:
       Genome
+      Lattice
       Lib
       Mind
   other-modules:
@@ -64,6 +65,7 @@ test-suite nerine-test
   main-is: Main.hs
   other-modules:
       GenomeTest
+      LatticeTest
       MindTest
       Paths_nerine
   autogen-modules:
diff --git a/src/Lattice.hs b/src/Lattice.hs
new file mode 100644
index 0000000..b69aa41
--- /dev/null
+++ b/src/Lattice.hs
@@ -0,0 +1,23 @@
+module Lattice
+  ( LatticeCell (..)
+  , Lattice
+  , LatticeRule
+  , updateLattice
+  ) where
+
+
+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
+
+
+updateLattice :: (Enum a) => Lattice a b -> [LatticeRule a b] -> Lattice a b
+updateLattice lattice rules =
+  let
+    mapRow = \(row, y) -> map 
+      (\((LatticeCell k _), x) ->
+        let rule = rules !! (fromEnum k)
+        in rule lattice x y
+      )
+      (zip row [0..])
+  in map mapRow (zip lattice [0..])
diff --git a/test/LatticeTest.hs b/test/LatticeTest.hs
new file mode 100644
index 0000000..a7d67d8
--- /dev/null
+++ b/test/LatticeTest.hs
@@ -0,0 +1,37 @@
+module LatticeTest (suite) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Lattice 
+
+suite :: TestTree
+suite = testGroup "lattice tests" $
+  [ latticeGrowth
+  ]
+
+
+data GrowKind = Empty | Plant deriving (Show, Enum, Eq)
+data GrowFlags = None deriving (Show, Eq)
+
+
+latticeGrowth :: TestTree
+latticeGrowth = testCase "growth update rule" $
+  let
+    plant = LatticeCell Plant None
+    empty = LatticeCell Empty None
+    lattice = [[ empty, empty, plant ]]
+    rules =
+      [ 
+        -- empty
+        \l x y -> 
+          if kind ((l !! y) !! (x+1)) == Plant
+          then LatticeCell Plant None
+          else LatticeCell Empty None
+        -- plant
+        , \_ _ _ -> LatticeCell Plant None
+      ] :: [LatticeRule GrowKind GrowFlags]
+    lattice' = updateLattice lattice rules
+    lattice'' = updateLattice lattice' rules
+  in do
+    lattice' @?= [[ empty, plant, plant ]]
+    lattice'' @?= [[ plant, plant, plant ]]
diff --git a/test/Main.hs b/test/Main.hs
index 907bbdd..24666a6 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,9 +4,11 @@ import Test.Tasty
 
 import qualified MindTest
 import qualified GenomeTest
+import qualified LatticeTest
 
 main :: IO ()
 main = defaultMain $ testGroup "all tests" $
   [ MindTest.suite
   , GenomeTest.suite
+  , LatticeTest.suite
   ]
-- 
cgit v1.2.1