hunt warnings
This commit is contained in:
parent
8b26781217
commit
bc08ca55a4
6 changed files with 24 additions and 63 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue