game of life works now

affection.cabal

@@ -148,5 +148,6 @@ executable example01
                      , linear
                      , matrix
                      , nanovg
+                     , deepseq
   else
     buildable:       False

examples/example01/Main.hs

@@ -3,18 +3,23 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 
 import Affection as A
+import SDL (($=))
 import qualified SDL
+import qualified Graphics.Rendering.OpenGL as GL
 
 import Control.Concurrent.STM
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad (when)
+import Control.DeepSeq (deepseq)
 
 import Data.Matrix as M
 import qualified Data.Set as S
 
 import System.Random (randomRIO)
 
-import NanoVG
+import NanoVG hiding (V2(..))
+
+import Linear
 
 import Foreign.C.Types (CInt(..))
 
@@ -30,12 +35,13 @@ main = do
   logIO A.Debug "Starting"
   let conf = AffectionConfig
         { initComponents = All
-        , windowTitle = "affection: example00"
+        , windowTitle = "affection: example01"
         , windowConfig = SDL.defaultWindow
           { SDL.windowOpenGL = Just SDL.defaultOpenGL
             { SDL.glProfile = SDL.Core SDL.Normal 3 3
             }
           , SDL.windowInitialSize = SDL.V2 600 600
+          , SDL.windowResizable = True
           }
         , initScreenMode = SDL.Windowed
         , canvasSize = Nothing
@@ -66,7 +72,10 @@ load = do
       (Window empty1)
       (Keyboard empty3)
     , lifeMat = fullMatrix
+    , foodMat = fromList 60 60 (repeat 10)
+    , timeMat = M.zero 60 60
     , nano = nanoCtx
+    , lastUpdate = 0
     }
 
 pre :: Affection UserData ()
@@ -74,8 +83,13 @@ pre = do
   sd <- getAffection
   _ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc
   _ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR
+  _ <- partSubscribe (subKeyboard $ subsystems sd) showFPS
   _ <- partSubscribe (subWindow   $ subsystems sd) exitOnWindowClose
-  return ()
+  _ <- partSubscribe (subWindow   $ subsystems sd) windowResize
+  now <- getElapsedTime
+  putAffection sd
+    { lastUpdate = floor now
+    }
 
 exitOnEsc :: KeyboardMessage -> Affection UserData ()
 exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
@@ -88,14 +102,28 @@ exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
 reloadOnR :: KeyboardMessage -> Affection UserData ()
 reloadOnR (MsgKeyboardEvent _ _ _ _ sym) =
   case SDL.keysymKeycode sym of
-    SDL.KeycodeR -> do
+    SDL.KeycodeR -> reload
+    _ -> return ()
+
+reload :: Affection UserData ()
+reload = do
   ud <- getAffection
+  now <- getElapsedTime
   randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599]
   let fullMatrix = fromList 60 60 randList
-      nState <- liftIO $ load
   putAffection ud
     { lifeMat = fullMatrix
+    , foodMat = fromList 60 60 (repeat 10)
+    , timeMat = M.zero 60 60
+    , lastUpdate = floor now
     }
+
+showFPS :: KeyboardMessage -> Affection UserData ()
+showFPS (MsgKeyboardEvent _ _ _ _ sym) =
+  case SDL.keysymKeycode sym of
+    SDL.KeycodeF -> do
+      dt <- getDelta
+      liftIO $ logIO A.Debug $ "FPS: " ++ show (1 / dt)
     _ -> return ()
 
 exitOnWindowClose :: WindowMessage -> Affection UserData ()
@@ -106,6 +134,15 @@ exitOnWindowClose wm =
       quit
     _ -> return ()
 
+windowResize :: WindowMessage -> Affection UserData ()
+windowResize msg = case msg of
+  (MsgWindowResize _ _ (V2 w h)) -> do
+    liftIO $ logIO A.Debug "Window resized"
+    let nw = floor (fromIntegral h)
+        dw = floor ((fromIntegral w - fromIntegral nw) / 2)
+    GL.viewport $= (GL.Position dw 0, GL.Size nw h)
+  _ -> return ()
+
 handle :: [SDL.EventPayload] -> Affection UserData ()
 handle es = do
   (Subsystems a b) <- subsystems <$> getAffection
@@ -115,64 +152,89 @@ handle es = do
 update :: Double -> Affection UserData ()
 update _ = do
   ud <- getAffection
-  -- when (lastUpdate ud < floor now) $ do
+  -- now <- getElapsedTime
-  liftIO $ logIO A.Debug "stepping life"
+  when (True) $ do
     newList <- mapM (\coord -> do
-    let x = (coord `div` 60) + 1
+      let x = (coord `mod` 60) + 1
-        y = (coord `mod` 60) + 1
+          y = (coord `div` 60) + 1
           subm
             | x == 1 && y == 1 =
-            (submatrix 60 60 60 60 (lifeMat ud) <-> submatrix 1 2 60 60 (lifeMat ud))
+              (submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud))
-            <|>
+              <->
-            (submatrix 60 60 1 2 (lifeMat ud) <-> submatrix 1 2 1 2 (lifeMat ud))
+              (submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud))
             | x == 1 && y == 60 =
-            (submatrix 60 60 59 60 (lifeMat ud) <-> submatrix 1 2 59 60 (lifeMat ud))
+              (submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud))
-            <|>
+              <->
-            (submatrix 60 60 1 1 (lifeMat ud) <-> submatrix 1 2 1 1 (lifeMat ud))
+              (submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud))
             | x == 60 && y == 1 =
-            (submatrix 59 60 60 60 (lifeMat ud) <-> submatrix 1 1 60 60 (lifeMat ud))
+              (submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (lifeMat ud))
-            <|>
+              <->
-            (submatrix 59 60 1 2 (lifeMat ud) <-> submatrix 1 1 1 2 (lifeMat ud))
+              (submatrix 1 2 59 60 (lifeMat ud) <|> submatrix 1 2 1 1 (lifeMat ud))
             | x == 60 && y == 60 =
-            (submatrix 59 60 59 60 (lifeMat ud) <-> submatrix 1 1 59 60 (lifeMat ud))
+              (submatrix 59 60 59 60 (lifeMat ud) <|> submatrix 59 60 1 1 (lifeMat ud))
-            <|>
+              <->
-            (submatrix 59 60 1 1 (lifeMat ud) <-> submatrix 1 1 1 1 (lifeMat ud))
+              (submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud))
             | x == 1 =
-            (submatrix 60 60 (y - 1) (y + 1) (lifeMat ud))
+              (submatrix (y - 1) (y + 1) 60 60 (lifeMat ud))
-            <->
+              <|>
-            (submatrix 1 2 (y - 1) (y + 1) (lifeMat ud))
+              (submatrix (y - 1) (y + 1) 1 2 (lifeMat ud))
             | y == 1 =
-            (submatrix (x - 1) (x + 1) 60 60 (lifeMat ud))
+              (submatrix 60 60 (x - 1) (x + 1) (lifeMat ud))
-            <|>
-            (submatrix (x - 1) (x + 1) 1 2 (lifeMat ud))
-          | x == 60 =
-            (submatrix 1 1 (y - 1) (y + 1) (lifeMat ud))
               <->
-            (submatrix 59 60 (y - 1) (y + 1) (lifeMat ud))
+              (submatrix 1 2 (x - 1) (x + 1) (lifeMat ud))
-          | y == 60 =
+            | x == 60 =
-            (submatrix (x - 1) (x + 1) 1 1 (lifeMat ud))
+              (submatrix (y - 1) (y + 1) 59 60 (lifeMat ud))
               <|>
-            (submatrix (x -1 ) (x + 1) 59 60 (lifeMat ud))
+              (submatrix (y - 1) (y + 1) 1 1 (lifeMat ud))
+            | y == 60 =
+              (submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud))
+              <->
+              (submatrix 1 1 (x - 1) (x + 1) (lifeMat ud))
             | otherwise =
-            submatrix (x - 1) (x + 1) (y - 1) (y + 1) (lifeMat ud)
+              submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
           life = countLife subm
-    if (lifeMat ud) M.! (x, y) == 1
+      if (lifeMat ud) M.! (y, x) == 1
       then if life == 2 || life == 3
-      then return 1
+        then if foodMat ud M.! (y, x) > 0
-      else return 0
+          then return (1, (foodMat ud M.! (y, x)) - 1, 0)
+          else return (0, foodMat ud M.! (y, x), 1)
+        else return (0, foodMat ud M.! (y, x), 1)
       else if life == 3
-      then return 1
+        then if foodMat ud M.! (y, x) > 0
-      else return 0
+          then return (1, (foodMat ud M.! (y, x)) - 1, 0)
+          else return
+            ( 0
+            , if timeMat ud M.! (y, x) > 10
+              then min 10 ((foodMat ud M.! (y, x)) + 1)
+              else foodMat ud M.! (y, x)
+            , timeMat ud M.! (y, x) + 1
+            )
+        else return
+          ( 0
+          , if timeMat ud M.! (y, x) > 10
+            then min 10 ((foodMat ud M.! (y, x)) + 1)
+            else foodMat ud M.! (y, x)
+          , (timeMat ud M.! (y, x)) + 1
+          )
       ) [0..3599]
-  let newM = fromList 60 60 newList
+    let newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList)
-  putAffection ud
+    let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
-    { lifeMat = newM
+    let newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
+    if (newLifeMat == M.zero 60 60)
+    then
+      reload
+    else
+      putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud)
+        { lifeMat = newLifeMat
+        , foodMat = newFoodMat
+        , timeMat = newTimeMat
+        -- , lastUpdate = floor now
         }
 
 countLife :: Matrix Word -> Word
 countLife mat = res - (mat M.! (2, 2))
   where
-    res = foldr (\a acc -> a + acc) 0 mat
+    res = foldr (\a acc -> acc + a) 0 mat
 
 draw :: Affection UserData ()
 draw = do
@@ -181,8 +243,8 @@ draw = do
     beginFrame (nano ud) 600 600 1
     save (nano ud)
     mapM_ (\coord -> do
-      let x = coord `div` 60
+      let x = coord `mod` 60
-          y = coord `mod` 60
+          y = coord `div` 60
           ctx = nano ud
           mult = lifeMat ud M.! (x + 1, y + 1)
       -- logIO A.Debug $ show mult
@@ -192,7 +254,7 @@ draw = do
       then do
         fillColor ctx (rgba 255 255 255 255)
       else do
-        fillColor ctx (rgba 0 0 0 255)
+        fillColor ctx (rgba 0 (fromIntegral $ 25 * (foodMat ud M.! (x+1, y+1))) 0 255)
       fill ctx
       ) [0..3599]
     restore (nano ud)

examples/example01/Types.hs

@@ -14,8 +14,11 @@ import Control.Monad.IO.Class (liftIO)
 
 data UserData = UserData
   { lifeMat    :: Matrix Word
+  , foodMat    :: Matrix Word
+  , timeMat    :: Matrix Word
   , subsystems :: Subsystems
   , nano       :: Context
+  , lastUpdate :: Int
   }
 
 data Subsystems = Subsystems