From e653391ab64e7474bbea4f741bda72424226d5cd Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 21 Dec 2017 14:43:13 +0100 Subject: [PATCH] linted --- src/Commons.hs | 6 ++--- src/InGame.hs | 62 ++++++++++++++++++++++++-------------------------- src/Init.hs | 4 ++-- src/Main.hs | 2 +- src/Menu.hs | 10 ++++---- src/Types.hs | 4 ++-- 6 files changed, 42 insertions(+), 46 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index ba9a293..8e74d87 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module Commons where import Affection @@ -26,7 +24,7 @@ toR :: Double -> Double toR deg = deg * pi / 180 wrapAround :: (Fractional t, Ord t, Num t) => V2 t -> t -> V2 t -wrapAround (V2 nx ny) width = (V2 nnx nny) +wrapAround (V2 nx ny) width = V2 nnx nny where nnx | nx > 800 + half = nx - (800 + width) @@ -119,4 +117,4 @@ drawHaskelloid (Haskelloid pos _ rot _ div img) = do ctx <- nano <$> getAffection liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255 where - dim = (fmap (/ fromIntegral div) (V2 100 100)) + dim = fmap (/ fromIntegral div) (V2 100 100) diff --git a/src/InGame.hs b/src/InGame.hs index 1eefe50..c7e14cc 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -77,8 +77,8 @@ shoot = do ud <- getAffection let Ship{..} = ship ud npew = Pew ppos pVel pewTTL - ppos = sPos + ((V2 0 25) `rotVec` sRot) - pVel = sVel + ((V2 0 pewVel) `rotVec` sRot) + ppos = sPos + (V2 0 25 `rotVec` sRot) + pVel = sVel + (V2 0 pewVel `rotVec` sRot) putAffection ud { shots = npew : shots ud } @@ -88,7 +88,7 @@ accelShip vel = do ud <- getAffection dt <- getDelta let s = ship ud - nVel = sVel s + fmap (realToFrac dt *) ((V2 0 vel) `rotVec` sRot s) + nVel = sVel s + fmap (realToFrac dt *) (V2 0 vel `rotVec` sRot s) putAffection ud { ship = s { sVel = nVel @@ -101,15 +101,15 @@ rotateShip deg = do dt <- getDelta putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) - deg * realToFrac dt + { sRot = sRot (ship ud) - deg * realToFrac dt } } rotVec :: (Num a, Floating a) => V2 a -> a -> V2 a rotVec (V2 x y) deg = V2 nx ny where - nx = x * (cos $ dtor deg) + y * (sin $ dtor deg) - ny = x * (sin $ dtor deg) - y * (cos $ dtor deg) + nx = x * cos (dtor deg) + y * sin (dtor deg) + ny = x * sin (dtor deg) - y * cos (dtor deg) dtor = (pi / 180 *) updateGame :: Double -> Affection UserData () @@ -162,7 +162,7 @@ checkShotDown = let ndiv = hDiv + 1 if ndiv > 5 then return [] - else return $ + else return [ Haskelloid hPos (V2 n1velx n1vely) n1rot n1pitch ndiv hImg , Haskelloid hPos (V2 n2velx n2vely) n2rot n2pitch ndiv hImg ] @@ -211,36 +211,34 @@ drawGame = do mapM_ drawHaskelloid (haskelloids ud) mapM_ drawPew (shots ud) case wonlost ud of - Just Lost -> liftIO $ do - let ctx = nano ud - save ctx - fontSize ctx 120 - fontFace ctx "modulo" - textAlign ctx (S.fromList [AlignCenter,AlignTop]) - fillColor ctx (rgba 255 255 255 255) - textBox ctx 0 200 800 "YOU LOST!" - fillColor ctx (rgba 255 128 0 255) - fontSize ctx 40 - textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" - restore ctx - Just Won -> liftIO $ do - let ctx = nano ud - save ctx - fontSize ctx 120 - fontFace ctx "modulo" - textAlign ctx (S.fromList [AlignCenter,AlignTop]) - fillColor ctx (rgba 255 255 255 255) - textBox ctx 0 200 800 "YOU WON!" - fillColor ctx (rgba 128 255 0 255) - fontSize ctx 40 - textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" - restore ctx + Just x -> drawWonLost x Nothing -> drawShip (ship ud) +drawWonLost :: WonLost -> Affection UserData () +drawWonLost wl = do + ctx <- nano <$> getAffection + liftIO $ do + let color = case wl of + Won -> rgba 128 255 0 255 + Lost -> rgba 255 128 0 255 + text = case wl of + Won -> "YOU WON!" + Lost -> "YOU LOsT!" + save ctx + fontSize ctx 120 + fontFace ctx "modulo" + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + fillColor ctx (rgba 255 255 255 255) + textBox ctx 0 200 800 text + fillColor ctx color + fontSize ctx 40 + textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" + restore ctx + drawShip :: Ship -> Affection UserData () drawShip Ship{..} = do ctx <- nano <$> getAffection - liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255 + liftIO $ drawImage ctx sImg (sPos - fmap (/2) dim) dim sRot 255 where dim = V2 40 40 diff --git a/src/Init.hs b/src/Init.hs index c60c7c4..74b2cdf 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -56,8 +56,8 @@ load = do exitFailure liftIO $ logIO A.Debug "Initializing subsystems" subs <- Subsystems - <$> (return . Window =<< newTVarIO []) - <*> (return . Keyboard =<< newTVarIO []) + <$> (Window <$> newTVarIO []) + <*> (Keyboard <$> newTVarIO []) liftIO $ logIO A.Debug "Setting viewport" GL.viewport $= (GL.Position 0 0, GL.Size 800 600) liftIO $ logIO A.Debug "Returning UserData" diff --git a/src/Main.hs b/src/Main.hs index 6b119a0..1107b74 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -41,7 +41,7 @@ main = do , eventLoop = handle , updateLoop = update , drawLoop = draw - , cleanUp = (\_ -> return ()) + , cleanUp = \_ -> return () } pre :: Affection UserData () diff --git a/src/Menu.hs b/src/Menu.hs index bffa789..201dbbe 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -24,7 +24,7 @@ import Foreign.C.Types import Types import Commons -loadMenu :: (Affection UserData ()) -> Affection UserData () +loadMenu :: Affection UserData () -> Affection UserData () loadMenu stateChange = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection @@ -54,12 +54,12 @@ updateMenu sec = do ud <- getAffection let nhs = map (updateHaskelloid sec) (haskelloids ud) case fade ud of - FadeIn ttl -> do + FadeIn ttl -> putAffection ud { fade = if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1 , haskelloids = nhs } - FadeOut ttl -> do + FadeOut ttl -> putAffection ud { fade = if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1 , haskelloids = nhs @@ -72,8 +72,8 @@ drawMenu = do liftIO $ do let ctx = nano ud alpha fio = case fio of - FadeIn d -> (floor (255 * (1 - d))) - FadeOut d -> (floor (255 * d)) + FadeIn d -> floor (255 * (1 - d)) + FadeOut d -> floor (255 * d) save ctx fontSize ctx 120 fontFace ctx "modulo" diff --git a/src/Types.hs b/src/Types.hs index 4ec6ede..36dd3c4 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -85,7 +85,7 @@ instance Participant Window WindowMessage UserData where return $ MsgId uuid MsgWindowEmptyEvent partUnSubscribe (Window t) (MsgId uuid _) = - liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid)) + liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid)) where filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool filterMsg (u, _) p = u /= p @@ -106,7 +106,7 @@ instance Participant Keyboard KeyboardMessage UserData where return $ MsgId uuid MsgKeyboardEmptyEvent partUnSubscribe (Keyboard t) (MsgId uuid _) = - liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid)) + liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid)) where filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool filterMsg (u, _) p = u /= p