diff --git a/src/Commons.hs b/src/Commons.hs index 0a15211..bb38165 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -11,7 +11,7 @@ import qualified Data.Map as M import Data.List (delete) import Data.Maybe (catMaybes) -import Control.Monad (foldM, when) +import Control.Monad (foldM, unless) import System.Random (randomRIO) @@ -24,7 +24,7 @@ toR deg = deg * pi / 180 clean :: UserData -> IO () clean ud = do - mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud) + mapM_ (gegl_node_drop . (\h -> hNodeGraph h M.! "root")) (haskelloids ud) gegl_node_drop $ nodeGraph ud M.! KeyRoot load :: SDL.Surface -> IO UserData @@ -47,11 +47,11 @@ load _ = do pnop <- gegl_node_new_child root $ Operation "gegl:nop" [] hnop <- gegl_node_new_child root $ Operation "gegl:nop" [] fgnop <- gegl_node_new_child root $ Operation "gegl:nop" [] - sover <- gegl_node_new_child root $ defaultOverOperation - hover <- gegl_node_new_child root $ defaultOverOperation - pover <- gegl_node_new_child root $ defaultOverOperation - bgover <- gegl_node_new_child root $ defaultOverOperation - fgover <- gegl_node_new_child root $ defaultOverOperation + sover <- gegl_node_new_child root defaultOverOperation + hover <- gegl_node_new_child root defaultOverOperation + pover <- gegl_node_new_child root defaultOverOperation + bgover <- gegl_node_new_child root defaultOverOperation + fgover <- gegl_node_new_child root defaultOverOperation translate <- gegl_node_new_child root $ Operation "gegl:translate" [ Property "x" $ PropertyDouble 375 , Property "y" $ PropertyDouble 275 @@ -120,7 +120,7 @@ load _ = do , Property "y" $ PropertyDouble 300 , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic ] - menuOver <- gegl_node_new_child root $ defaultOverOperation + menuOver <- gegl_node_new_child root defaultOverOperation gegl_node_link menuHeading menuTranslateHeading gegl_node_link_many [menuText, menuTranslateText, menuOver] _ <- gegl_node_connect_to menuTranslateHeading "output" menuOver "aux" @@ -160,7 +160,7 @@ load _ = do -- ) [] ([0..9] :: [Int]) -- liftIO $ gegl_node_link_many $ map hFlange hs -- liftIO $ gegl_node_link (last $ map hFlange hs) hnop - return $ UserData + return UserData { nodeGraph = myMap , ship = Ship { sPos = (375, 275) @@ -188,8 +188,8 @@ insertHaskelloid hasks split (px, py) = do Just x -> return $ x + 1 rot <- liftIO $ randomRIO (0, 360) pitch <- liftIO $ randomRIO (-45, 45) - tempRoot <- liftIO $ gegl_node_new - tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation + tempRoot <- liftIO gegl_node_new + tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation tempSvg <- gegl_node_new_child tempRoot $ Operation "gegl:svg-load" [ Property "path" $ PropertyString "assets/haskelloid.svg" , Property "width" $ PropertyInt (100 `div` rdiv) @@ -262,14 +262,14 @@ haskelloidShotDown h = do updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid updateHaskelloid sec h@Haskelloid{..} = do - let newX = (fst $ hPos) + sec * (fst $ hVel) - newY = (snd $ hPos) + sec * (snd $ hVel) + let newX = fst hPos + sec * fst hVel + newY = snd hPos + sec * snd hVel newRot = hRot + hPitch * sec (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) -- liftIO $ traceIO $ "moving to: " ++ show nnx ++ " " ++ show nny liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" [ Property "degrees" $ PropertyDouble newRot @@ -286,9 +286,7 @@ updateHaskelloid sec h@Haskelloid{..} = do 50 ) _ -> return Nothing - maybe (return ()) (\_ -> - lose - ) lost + maybe (return ()) (const lose) lost return h { hPos = (nnx, nny) , hRot = newRot @@ -297,23 +295,23 @@ updateHaskelloid sec h@Haskelloid{..} = do wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) wrapAround (nx, ny) width = (nnx, nny) where - nnx = - if nx > 800 - then nx - (800 + width) - else if nx < -width then nx + 800 + width else nx - nny = - if ny > 600 - then ny - (600 + width) - else if ny < -width then ny + 600 + width else ny + nnx + | nx > 800 = nx - (800 + width) + | nx < -width = nx + 800 + width + | otherwise = nx + nny + | ny > 600 = ny - (600 + width) + | ny < -width = ny + 600 + width + | otherwise = ny shotsUpd :: Double -> Particle -> Affection UserData Particle shotsUpd sec part@Particle{..} = do - let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) - newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) + let newX = fst particlePosition + sec * fromIntegral (fst particleVelocity) + newY = snd particlePosition + sec * fromIntegral (snd particleVelocity) (nnx, nny) = wrapAround (newX, newY) 4 liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] ud <- getAffection inters <- catMaybes <$> mapM (\h -> do @@ -329,7 +327,7 @@ shotsUpd sec part@Particle{..} = do Just _ -> return $ Just h Nothing -> return Nothing ) (haskelloids ud) - when (not $ null inters) $ + unless (null inters) $ haskelloidShotDown $ head inters lost <- liftIO $ gegl_rectangle_intersect (GeglRectangle (floor nnx) (floor nny) 4 4) @@ -339,12 +337,10 @@ shotsUpd sec part@Particle{..} = do 50 50 ) - maybe (return ()) (\_ -> - lose - ) lost + maybe (return ()) (const lose) lost return part { particlePosition = (nnx, nny) - , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive + , particleTimeToLive = if not $ null inters then 0 else particleTimeToLive } shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () diff --git a/src/InGame.hs b/src/InGame.hs index f275b09..9a9f8c1 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -41,7 +41,7 @@ loadGame = do { sPos = (375, 275) , sVel = (0, 0) , sRot = 0 - , sFlange = (nodeGraph ud M.! KeyShipRotate) + , sFlange = nodeGraph ud M.! KeyShipRotate } , pixelSize = 3 , state = InGame @@ -73,12 +73,12 @@ updateGame sec = do putAffection ud { pixelSize = pixelSize ud -1 } - let nx = (fst $ sPos $ ship ud) + (fst $ sVel $ ship ud) * sec - ny = (snd $ sPos $ ship ud) + (snd $ sVel $ ship ud) * sec + let nx = fst (sPos $ ship ud) + fst (sVel $ ship ud) * sec + ny = snd (sPos $ ship ud) + snd (sVel $ ship ud) * sec (nnx, nny) = wrapAround (nx, ny) 50 liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipRotate) $ Operation "gegl:rotate" [ Property "degrees" $ PropertyDouble $ sRot $ ship ud @@ -108,13 +108,13 @@ handleGameEvent sec e = do wd <- getAffection case SDL.eventPayload e of SDL.KeyboardEvent dat -> - case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of + case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of SDL.KeycodeLeft -> do ud <- getAffection when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost ud)) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) + 270 * sec + { sRot = sRot (ship ud) + 270 * sec } } SDL.KeycodeRight -> do @@ -122,14 +122,14 @@ handleGameEvent sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) - 270 * sec + { sRot = sRot (ship ud) - 270 * sec } } SDL.KeycodeUp -> when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do ud <- getAffection - let vx = -10 * (sin (toR $ (sRot $ ship ud))) + fst (sVel $ ship ud) - vy = -10 * (cos (toR $ (sRot $ ship ud))) + snd (sVel $ ship ud) + let vx = -10 * sin (toR $ sRot $ ship ud) + fst (sVel $ ship ud) + vy = -10 * cos (toR $ sRot $ ship ud) + snd (sVel $ ship ud) putAffection ud { ship = (ship ud) { sVel = (vx, vy) @@ -144,19 +144,19 @@ handleGameEvent sec e = do , Property "size-y" $ PropertyInt 8 ] -- ad <- get - let posX = (fst $ sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) - posY = (snd $ sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) - tempRoot <- liftIO $ gegl_node_new + let posX = fst (sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) + posY = snd (sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) + tempRoot <- liftIO gegl_node_new tempRect <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ posX - , Property "y" $ PropertyDouble $ posY + [ Property "x" $ PropertyDouble posX + , Property "y" $ PropertyDouble posY , Property "width" $ PropertyDouble 4 , Property "height" $ PropertyDouble 4 - , Property "color" $ PropertyColor $ (GEGL.RGBA 1 1 1 1) + , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 ] - tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation + tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation _ <- liftIO $ gegl_node_connect_to tempRect "output" tempOver "aux" - ips <- insertParticle (shots ud) $ + ips <- insertParticle (shots ud) Particle { particleTimeToLive = 5 , particleCreation = elapsedTime ad @@ -165,8 +165,8 @@ handleGameEvent sec e = do , particleVelocity = -- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud))) -- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud))) - ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) - , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) + ( (floor $ (-200) * (sin $ toR $ sRot $ ship ud)) + , (floor $ (-200) * (cos $ toR $ sRot $ ship ud)) ) , particlePitchRate = Rad 0 , particleRootNode = tempRoot diff --git a/src/Main.hs b/src/Main.hs index d324c96..a9afdf1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import Affection @@ -23,7 +23,7 @@ import Menu import InGame main :: IO () -main = withAffection $ AffectionConfig +main = withAffection AffectionConfig { initComponents = All , windowTitle = "Haskelloids" , windowConfig = defaultWindow