hunt warnings

This commit is contained in:
nek0 2020-05-04 13:40:57 +02:00
parent 8b26781217
commit bc08ca55a4
6 changed files with 24 additions and 63 deletions

View file

@ -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

View file

@ -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 ()

View file

@ -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 ()

View file

@ -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

View file

@ -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)

View file

@ -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