changes in changelog

.gitignore

@@ -1,2 +1,3 @@
 .stack-work/
-*~
+*~
+patterns

ChangeLog.md

@@ -1,4 +1,8 @@
 # Changelog for life
 
+## 12/01/2021 v0.1.2.0
+Updated main naive algorithm
+Added functionality to read .cells file
+
 ## 12/01/2021
 First commit

README.md

@@ -5,6 +5,8 @@
 You probably need libfreeglut installed.
 Then, run `life`
 
+You can load .cells files using `life my_file.cells`
+
 ### Keybindings:
 
 ```
@@ -29,4 +31,5 @@ TODO:
 
 - Hashlife
 - HUD
-- load and save files
+- save files
+- support for .rle

app/Main.hs

@@ -4,6 +4,7 @@ import Graphics.UI.GLUT
 import Data.IORef
 import Bindings
 import Engine
+import Parse
 
 timeStep :: Int 
 timeStep = 1000
@@ -11,15 +12,16 @@ timeStep = 1000
 
 main :: IO ()
 main = do
-  (_progName, _args) <- getArgsAndInitialize
+  (_progName, args) <- getArgsAndInitialize
   initialDisplayMode $= [DoubleBuffered]
   _window <- createWindow "Conway's game of life"
-  
-  
+
+  k <- if not $ null args then parse args else pure []
+
+  cells <- newIORef $ startingmem k
   pos <- newIORef (0, 0)
   time <- newIORef timeStep
   stop <- newIORef True
-  cells <- newIORef startingmem
   zoom <- newIORef 1
 
   reshapeCallback $= Just reshape

life.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           life
-version:        0.1.0.0
+version:        0.1.1.0
 description:    Please see the README on GitHub at <https://github.com/githubuser/life#readme>
 author:         Raphael Jacobs
 maintainer:     Raphy@airmail.cc
@@ -24,6 +24,7 @@ library
       Cube
       Display
       Engine
+      Parse
   other-modules:
       Paths_life
   hs-source-dirs:
@@ -33,6 +34,7 @@ library
     , OpenGL >=3.0.3.0
     , base >=4.7 && <5
     , containers >=0.6.2.1
+    , text >=1.2.4.0
   default-language: Haskell2010
 
 executable life
@@ -48,6 +50,7 @@ executable life
     , base >=4.7 && <5
     , containers >=0.6.2.1
     , life
+    , text >=1.2.4.0
   default-language: Haskell2010
 
 test-suite life-test
@@ -64,4 +67,5 @@ test-suite life-test
     , base >=4.7 && <5
     , containers >=0.6.2.1
     , life
+    , text >=1.2.4.0
   default-language: Haskell2010

package.yaml

@@ -1,5 +1,5 @@
 name:                life
-version:             0.1.1.0
+version:             0.1.2.0
 license:             BSD3
 author:              "Raphael Jacobs"
 maintainer:          "Raphy@airmail.cc"
@@ -23,6 +23,7 @@ dependencies:
 - OpenGL >= 3.0.3.0
 - GLUT >= 2.7.0.15
 - containers >= 0.6.2.1
+- text >= 1.2.4.0
 
 library:
   source-dirs: src

src/Bindings.hs

@@ -32,12 +32,12 @@ keyboardMouse cells z p t s key Down _ position@(Position x y) = do
         (Char 'z') -> t $~! \x -> x+50
         (Char 'x') -> t $~! \x -> if x > 50 then x-50 else 50
 
-        (Char 'f') -> cells $~! updatem
+        (Char 'f') -> get s >>= \x -> if x then cells $~! updatem else pure ()
         (Char ' ') -> s $~! not -- Forward one step
 
         (Char 'a') -> do
             k <- get z
-            if k > 1 then pure() else 
+            if k > 1 then pure () else 
                 z $~! const (k * 1.5) >>
                 p $~! \(x,y) -> (x*1.5, y*1.5) 
 

src/Cells.hs

@@ -2,7 +2,6 @@ module Cells (Cells, updatem, rendercells) where
 
 import Graphics.UI.GLUT
 import Engine
-import qualified Data.Set as S
 
 vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
 vertex3f (x, y, z) = vertex $ Vertex3 x y z
@@ -18,4 +17,4 @@ cell w (x, y) = renderPrimitive Quads $ mapM_ vertex3f
         y' = fromIntegral y/10
 
 rendercells :: Cells -> IO ()
-rendercells cells = mapM_ (cell 0.05) (S.toList cells)
+rendercells cells = mapM_ (cell 0.05) (pointlist cells)

src/Display.hs

@@ -40,5 +40,4 @@ display z cells pos = do
 
   color $ Color3 1 1 (1 :: Float)
   rendercells old
-  swapBuffers
-  print "render"
+  swapBuffers

src/Engine.hs

@@ -1,16 +1,21 @@
 {-# LANGUAGE BangPatterns #-}
-module Engine (startingmem, Cells, updatem, toggle, emptymem) where
+module Engine (startingmem, Cells, updatem, toggle, emptymem, pointlist) where
 
 -- Naive Method
 import qualified Data.Set as S
 
-type Cells = S.Set (Int, Int)
+data Cells = Cells {alive :: S.Set (Integer, Integer), changed :: S.Set (Integer, Integer)}
+    deriving (Show)
 
-emptymem :: S.Set (Int, Int)
-emptymem = S.empty
 
-startingmem :: S.Set (Int, Int)
-startingmem = S.fromList []
+pointlist :: Cells -> [(Integer, Integer)]
+pointlist = S.toList . alive
+
+emptymem :: Cells
+emptymem = Cells S.empty S.empty 
+
+startingmem :: [(Integer, Integer)] -> Cells
+startingmem x = Cells (S.fromList x) (S.fromList x)
 
 --Returns moore neighborhood of given cell without the central cell
 neighbors :: (Num a, Num b, Enum a, Enum b, Eq a, Eq b) => (a, b) -> [(a, b)]
@@ -24,14 +29,21 @@ check :: (Ord a, Ord b, Num a, Num b, Enum a, Enum b) => S.Set (a, b) -> (a, b)
 check !mem (x, y) = length . filter id . fmap (`S.member` mem) $ neighbors (x, y)
 
 -- toggles a single cell
-toggle :: (Ord a, Ord b) => S.Set (a, b) -> (a, b) -> S.Set (a, b)
-toggle !mem (x, y) = if S.member (x, y) mem then S.delete (x, y) mem else S.insert (x, y) mem
+toggle :: Cells -> (Integer, Integer) -> Cells
+toggle !mem (x, y) = if S.member (x, y) a then Cells (S.delete (x, y) a) tmp else Cells (S.insert (x, y) a) tmp
+    where a = alive mem 
+          c = changed mem
+          tmp = S.insert (x, y) (S.insert (x-1, y) c) -- We add a nearby cell so that (x, y) will be updated as neighbour of a changed cell.
 
 
-updatem :: (Ord a, Ord b, Num a, Num b, Enum a, Enum b) => S.Set (a, b) -> S.Set (a, b)
-updatem !active = S.union toKeep toAdd where
-          frontier = S.unions . S.map (\x -> S.difference (S.fromList (neighbors x)) active) $ active 
-          toKeep = S.filter live active
-          toAdd = S.filter born frontier
-          live x = 2 == check active x || 3 == check active x -- This part can be abstracted to easily support more automatas
-          born x = 3 == check active x
+
+updatem :: Cells -> Cells
+updatem !mem = Cells (S.union toKeep toAdd) (S.union toAdd toRemove) where
+          c = changed mem
+          a = alive mem
+          frontier = S.partition (`S.member` a) . S.unions . S.map (S.fromList . neighbors) $ c
+          toAdd = S.filter born (snd frontier)
+          toRemove = S.filter (not . live) (fst frontier)
+          toKeep = S.difference a toRemove
+          live x = 2 == check a x || 3 == check a x -- This part can be abstracted to easily support more automatas
+          born x = 3 == check a x

src/Parse.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+module Parse where
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+parse args = do 
+    c <- T.readFile (head args)
+    let [content, filename] = T.split (== '.') . T.pack . head $ args
+    case filename of
+        "cells" -> pure $ fmap flipxy . concat . tocoords . zip [0..] . fmap findOs . filtercommentsc . T.lines $ c
+        "rle" -> pure $ []
+
+flipxy :: (b, a) -> (a, b)
+flipxy (x, y) = (y, x)
+
+-- .cells file parsing
+filtercommentsc :: [T.Text] -> [T.Text]
+filtercommentsc = filter (not . T.isPrefixOf "!")
+
+findOs :: T.Text -> [Integer]
+findOs = fmap fst . filter (\(_, y) -> y == 'O' ) . zip [0..] . T.unpack
+
+tocoords :: [(a, [b])] -> [[(a, b)]]
+tocoords = fmap (\(x, xs) -> fmap (x,) xs)
+
+-- .rle file parsing