diff --git a/affection.cabal b/affection.cabal index 18ce042..64d1d7f 100644 --- a/affection.cabal +++ b/affection.cabal @@ -148,5 +148,6 @@ executable example01 , linear , matrix , nanovg + , deepseq else buildable: False diff --git a/examples/example01/Main.hs b/examples/example01/Main.hs index 28a1ec7..ae9fa98 100644 --- a/examples/example01/Main.hs +++ b/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 - ud <- getAffection - randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599] - let fullMatrix = fromList 60 60 randList - nState <- liftIO $ load - putAffection ud - { lifeMat = fullMatrix - } + 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 + 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 - liftIO $ logIO A.Debug "stepping life" - newList <- mapM (\coord -> do - let x = (coord `div` 60) + 1 - y = (coord `mod` 60) + 1 - subm - | x == 1 && y == 1 = - (submatrix 60 60 60 60 (lifeMat ud) <-> submatrix 1 2 60 60 (lifeMat ud)) - <|> - (submatrix 60 60 1 2 (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 60 60 1 1 (lifeMat ud) <-> submatrix 1 2 1 1 (lifeMat ud)) - | x == 60 && y == 1 = - (submatrix 59 60 60 60 (lifeMat ud) <-> submatrix 1 1 60 60 (lifeMat ud)) - <|> - (submatrix 59 60 1 2 (lifeMat ud) <-> submatrix 1 1 1 2 (lifeMat ud)) - | x == 60 && y == 60 = - (submatrix 59 60 59 60 (lifeMat ud) <-> submatrix 1 1 59 60 (lifeMat ud)) - <|> - (submatrix 59 60 1 1 (lifeMat ud) <-> submatrix 1 1 1 1 (lifeMat ud)) - | x == 1 = - (submatrix 60 60 (y - 1) (y + 1) (lifeMat ud)) - <-> - (submatrix 1 2 (y - 1) (y + 1) (lifeMat ud)) - | y == 1 = - (submatrix (x - 1) (x + 1) 60 60 (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)) - | y == 60 = - (submatrix (x - 1) (x + 1) 1 1 (lifeMat ud)) - <|> - (submatrix (x -1 ) (x + 1) 59 60 (lifeMat ud)) - | otherwise = - submatrix (x - 1) (x + 1) (y - 1) (y + 1) (lifeMat ud) - life = countLife subm - if (lifeMat ud) M.! (x, y) == 1 - then if life == 2 || life == 3 - then return 1 - else return 0 - else if life == 3 - then return 1 - else return 0 - ) [0..3599] - let newM = fromList 60 60 newList - putAffection ud - { lifeMat = newM - } + -- now <- getElapsedTime + when (True) $ do + newList <- mapM (\coord -> do + let x = (coord `mod` 60) + 1 + y = (coord `div` 60) + 1 + subm + | x == 1 && y == 1 = + (submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud)) + <-> + (submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud)) + | x == 1 && y == 60 = + (submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud)) + <-> + (submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud)) + | x == 60 && y == 1 = + (submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (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 59 60 1 1 (lifeMat ud)) + <-> + (submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud)) + | x == 1 = + (submatrix (y - 1) (y + 1) 60 60 (lifeMat ud)) + <|> + (submatrix (y - 1) (y + 1) 1 2 (lifeMat ud)) + | y == 1 = + (submatrix 60 60 (x - 1) (x + 1) (lifeMat ud)) + <-> + (submatrix 1 2 (x - 1) (x + 1) (lifeMat ud)) + | x == 60 = + (submatrix (y - 1) (y + 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 (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud) + life = countLife subm + if (lifeMat ud) M.! (y, x) == 1 + then if life == 2 || life == 3 + then if foodMat ud M.! (y, x) > 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 if foodMat ud M.! (y, x) > 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 newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList) + let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList) + 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 - y = coord `mod` 60 + let x = 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) diff --git a/examples/example01/Types.hs b/examples/example01/Types.hs index 615651e..2ce7855 100644 --- a/examples/example01/Types.hs +++ b/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