diff --git a/examples/example00/Main.hs b/examples/example00/Main.hs index 6986905..3f8acfb 100644 --- a/examples/example00/Main.hs +++ b/examples/example00/Main.hs @@ -7,10 +7,9 @@ import Affection as A import Control.Concurrent.STM import Control.Concurrent.MVar -import Control.Monad.IO.Class (liftIO) import Control.Monad -import qualified SDL hiding (Window(..)) +import qualified SDL import Data.Maybe (isJust, fromJust) import Data.String @@ -129,19 +128,19 @@ pre sd = do return () exitOnQ :: MVar Bool -> KeyboardMessage -> Affection () -exitOnQ break (MsgKeyboardEvent _ _ _ _ sym) = +exitOnQ nextStep (MsgKeyboardEvent _ _ _ _ sym) = case SDL.keysymKeycode sym of SDL.KeycodeQ -> do liftIO $ logIO Debug "Yo dog I heard..." - void $ liftIO $ swapMVar break False + void $ liftIO $ swapMVar nextStep False _ -> return () exitOnWindowClose :: MVar Bool -> WindowMessage -> Affection () -exitOnWindowClose break wm = +exitOnWindowClose nextStep wm = case wm of MsgWindowClose _ _ -> do liftIO $ logIO Debug "I heard another one..." - void $ liftIO $ swapMVar break False + void $ liftIO $ swapMVar nextStep False _ -> return () joyConnectDisconnect :: MVar [SDL.Joystick] -> JoystickMessage -> Affection () @@ -164,10 +163,13 @@ handle sd es = do mapM_ (\e -> liftIO $ logIO Verbose $ "LEFTOVER: " <> fromString (show e)) leftovers +update :: StateData -> Double -> Affection () update _ _ = return () +draw :: StateData -> Affection () draw _ = return () +clean :: StateData -> IO () clean _ = return () generalSubscribers diff --git a/examples/example01/Main.hs b/examples/example01/Main.hs index 419f0f8..87484cd 100644 --- a/examples/example01/Main.hs +++ b/examples/example01/Main.hs @@ -3,13 +3,10 @@ {-# LANGUAGE ForeignFunctionInterface #-} import Affection as A -import SDL (($=)) import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL import Control.Concurrent.STM import Control.Concurrent.MVar -import Control.Monad.IO.Class (liftIO) import Control.Monad import Control.DeepSeq (deepseq) @@ -21,8 +18,6 @@ import System.Random (randomRIO) import NanoVG hiding (V2(..)) -import Linear - import Foreign.C.Types (CInt(..)) -- internal imports @@ -69,7 +64,7 @@ load = do liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "making random" - randList <- mapM (\_ -> randomRIO (0,1)) [0..3599] + randList <- mapM (\_ -> randomRIO (0,1)) [0 .. (3599 :: Int)] liftIO $ logIO A.Debug "creating context" nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) let fullMatrix = fromList 60 60 randList @@ -121,11 +116,10 @@ reloadOnR ud (MsgKeyboardEvent _ _ _ _ sym) = case SDL.keysymKeycode sym of SDL.KeycodeR -> reload ud _ -> return () -reloadOnR _ _ = return () reload :: UserData -> Affection () reload ud = do - randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599] + randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0 .. (3599 :: Int)] let fullMatrix = fromList 60 60 randList void $ liftIO $ swapMVar (lifeMat ud) fullMatrix void $ liftIO $ swapMVar (foodMat ud) (fromList 60 60 (repeat 10)) @@ -138,7 +132,6 @@ showFPS (MsgKeyboardEvent _ _ _ _ sym) = dt <- getDelta liftIO $ logIO A.Debug $ "FPS: " <> fromString (show (1 / dt)) _ -> return () -showFPS _ = return () exitOnWindowClose :: MVar Bool -> WindowMessage -> Affection () exitOnWindowClose step wm = @@ -147,7 +140,6 @@ exitOnWindowClose step wm = liftIO $ logIO A.Debug "I heard another one..." void $ liftIO $ swapMVar step False _ -> return () -exitOnWindowClose _ _ = return () handle :: UserData -> [SDL.EventPayload] -> Affection () handle ud es = do @@ -156,7 +148,7 @@ handle ud es = do return () update :: UserData -> Double -> Affection () -update ud dt = do +update ud _ = do -- liftIO $ logIO A.Debug ("FPS: " <> fromString (show (1/dt))) pastLife <- liftIO $ readMVar (lifeMat ud) pastFood <- liftIO $ readMVar (foodMat ud) @@ -200,15 +192,6 @@ update ud dt = do | otherwise = (submatrix (y - 1) (y + 1) (x - 1) (x + 1) pastLife) life = countLife subm - ret - | life == 0 && pastLife M.! (y, x) == 0 = - ( 0 - , if pastTime M.! (y, x) >= 10 - then min 10 (pastFood M.! (y, x) + 1) - else min 10 (pastFood M.! (y, x)) - , pastTime M.! (y, x) + 1 - ) - | otherwise = (1, 1, 1) if pastLife M.! (y, x) == 1 then if (life == 2 || life == 3) && pastFood M.! (y, x) > 0 then return (1, (pastFood M.! (y, x)) - 1, 0) @@ -216,7 +199,7 @@ update ud dt = do else if life == 3 && pastFood M.! (y, x) > 0 then return (1, (pastFood M.! (y, x)) - 1, 0) else return - ( 0 + ( (0 :: Word) , if pastTime M.! (y, x) > 10 then min 10 ((pastFood M.! (y, x)) + 1) else min 10 (pastFood M.! (y, x)) @@ -233,7 +216,6 @@ update ud dt = do ((newLifeMat, newFoodMat, newTimeMat) `deepseq` return ()) void $ liftIO $ swapMVar (lifeMat ud) newLifeMat void $ liftIO $ swapMVar (timeMat ud) newTimeMat - -- void $ liftIO $ swapMVar (foodMat ud) newFoodMat countLife :: Matrix Word -> Word countLife mat = res - (mat M.! (2, 2)) @@ -265,4 +247,5 @@ draw ud = do restore (nano ud) endFrame (nano ud) +clean :: UserData -> IO () clean _ = return () diff --git a/examples/example02/Main.hs b/examples/example02/Main.hs index 2cd33a2..7fc079e 100644 --- a/examples/example02/Main.hs +++ b/examples/example02/Main.hs @@ -3,13 +3,10 @@ {-# LANGUAGE ForeignFunctionInterface #-} import Affection as A -import SDL (($=)) import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL import Control.Concurrent.STM import Control.Concurrent.MVar -import Control.Monad.IO.Class (liftIO) import Control.Monad import Control.DeepSeq (deepseq) @@ -21,8 +18,6 @@ import System.Random (randomRIO) import NanoVG hiding (V2(..)) -import Linear - import Foreign.C.Types (CInt(..)) -- internal imports @@ -72,14 +67,14 @@ load = do liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "making random" - randList <- mapM (\_ -> randomRIO (0,1)) [0..3599] + randList <- mapM (\_ -> randomRIO (0,1)) [0 .. (3599 :: Int)] liftIO $ logIO A.Debug "creating context" nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) let fullMatrix = fromList 60 60 randList -- logIO A.Debug $ prettyMatrix fullMatrix empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection ())]) empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection ())]) - (\life food time break -> UserData + (\life food time nextStep -> UserData { subsystems = Subsystems (Window empty1) (Keyboard empty3) @@ -87,7 +82,7 @@ load = do , foodMat = food , timeMat = time , nano = nanoCtx - , doNextStep = break + , doNextStep = nextStep } ) <$> newMVar fullMatrix @@ -124,11 +119,10 @@ reloadOnR ud (MsgKeyboardEvent _ _ _ _ sym) = case SDL.keysymKeycode sym of SDL.KeycodeR -> reload ud _ -> return () -reloadOnR _ __ = return () reload :: UserData -> Affection () reload ud = do - randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599] + randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0 .. (3599 :: Int)] let fullMatrix = fromList 60 60 randList void $ liftIO $ swapMVar (lifeMat ud) fullMatrix void $ liftIO $ swapMVar (foodMat ud) (fromList 60 60 (repeat maxFood)) @@ -141,7 +135,6 @@ showFPS (MsgKeyboardEvent _ _ _ _ sym) = dt <- getDelta liftIO $ logIO A.Debug $ "FPS: " <> fromString (show (1 / dt)) _ -> return () -showFPS _ = return () exitOnWindowClose :: MVar Bool -> WindowMessage -> Affection () exitOnWindowClose step wm = @@ -150,7 +143,6 @@ exitOnWindowClose step wm = liftIO $ logIO A.Debug "I heard another one..." void $ liftIO $ swapMVar step False _ -> return () -exitOnWindowClose _ _ = return () handle :: UserData -> [SDL.EventPayload] -> Affection () handle ud es = do @@ -202,15 +194,6 @@ update ud _ = do | otherwise = (submatrix (y - 1) (y + 1) (x - 1) (x + 1) pastLife) life = countLife subm - ret - | life == 0 && pastLife M.! (y, x) == 0 = - ( 0 - , if pastTime M.! (y, x) >= 10 - then min 10 (pastFood M.! (y, x) + 1) - else min 10 (pastFood M.! (y, x)) - , pastTime M.! (y, x) + 1 - ) - | otherwise = (1, 1, 1) if pastLife M.! (y, x) == 1 then if (life == 2 || life == 3) && pastFood M.! (y, x) > 0 then return (1, (pastFood M.! (y, x)) - 1, 0) @@ -218,7 +201,7 @@ update ud _ = do else if life == 3 && pastFood M.! (y, x) > 0 then return (1, (pastFood M.! (y, x)) - 1, 0) else return - ( 0 + ( 0 :: Word , if pastTime M.! (y, x) > 10 then min maxFood ((pastFood M.! (y, x)) + 1) else min maxFood (pastFood M.! (y, x)) @@ -252,11 +235,11 @@ draw ud = liftIO $ do let x = coord `mod` 60 y = coord `div` 60 ctx = nano ud - mult = pastLife M.! (x + 1, y + 1) + multiplicator = pastLife M.! (x + 1, y + 1) -- logIO A.Debug $ show mult beginPath ctx rect ctx (fromIntegral $ x * 10) (fromIntegral $ y * 10) 10 10 - if mult == 1 + if multiplicator == 1 then fillColor ctx (rgba 255 255 255 255) else @@ -266,4 +249,5 @@ draw ud = liftIO $ do restore (nano ud) endFrame (nano ud) +clean :: UserData -> IO () clean _ = return () diff --git a/src/Affection.hs b/src/Affection.hs index 3acbcb1..2b1f908 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -21,9 +21,6 @@ import System.Clock import Control.Monad.Loops import Control.Monad.State.Strict -import Control.Monad.IO.Class (liftIO) - -import Foreign.C.Types (CInt(..)) import Affection.Types as A import Affection.Class as A @@ -70,10 +67,6 @@ withAffection AffectionConfig{..} = do _ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 contexts <- zip (map (\(x,_,_) -> x) windows) <$> mapM (SDL.glCreateContext . (\(_,y,_) -> y)) windows - -- let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfigs - -- (w, h) = case canvasSize of - -- Just (cw, ch) -> (cw, ch) - -- Nothing -> (fromIntegral rw, fromIntegral rh) mapM_ (\w -> flip SDL.setWindowMode ((\(_,_,z) -> z) w) ((\(_,y,_) -> y) w)) windows -- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows liftIO $ logIO Debug "Getting Time" @@ -92,7 +85,7 @@ withAffection AffectionConfig{..} = do , pausedTime = False } -- initialize and run state - (_, nState) <- runStateT + (_, _) <- runStateT (A.runState (do liftIO $ logIO Debug "Starting Loop" @@ -126,7 +119,7 @@ withAffection AffectionConfig{..} = do liftIO GL.flush -- actual displaying of newly drawn frame mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows - -- -- save new time + -- save new time ad3 <- get when (sysTime ad == sysTime ad3) ( put ad3 diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index 949315c..a7d8eb4 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -63,7 +63,6 @@ data AffectionData = AffectionData , SDL.GLContext -- --^ Associated OpenGL context ) ] -- ^ OpenGL rendering contexts - , screenMode :: SDL.WindowMode -- ^ current screen mode , elapsedTime :: Double -- ^ Elapsed time in seconds , deltaTime :: Double -- ^ Elapsed time in seconds since last tick , sysTime :: TimeSpec -- ^ System time (NOT the time on the clock) diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs index d0c5e0b..763f0ee 100644 --- a/src/Affection/Util.hs +++ b/src/Affection/Util.hs @@ -56,7 +56,7 @@ toggleScreen windowIdent = do put ad { sysTime = now , drawWindows = map - (\e@(lid, win, mod) -> + (\e@(lid, win, _) -> if lid == ident then (lid, win, newMode) else e