diff --git a/haskelloids.cabal b/haskelloids.cabal index 5caffb9..625972d 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -67,7 +67,7 @@ executable haskelloids -- Other library packages from which modules are imported. build-depends: base >=4.9 && <4.11 - , affection <= 0.0.0.8 + , affection <= 0.0.0.9 , sdl2 >= 2.1.3.1 , OpenGL , containers diff --git a/src/InGame.hs b/src/InGame.hs index f1103b1..27e846f 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -33,12 +33,17 @@ pewTTL = 10 dRot :: Float dRot = 150 -loadGame :: Affection UserData () -> Affection UserData () -> Affection UserData () +loadGame + :: Affection UserData () + -> Affection UserData () + -> Affection UserData () loadGame stateChange clean = do liftIO $ logIO A.Debug "loading game" ud <- getAffection nhs <- newHaskelloids - kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange clean) + kid <- partSubscribe + (subKeyboard $ subsystems ud) + (handleGameKeys stateChange clean) putAffection ud { stateUUIDs = UUIDClean [] [kid] , haskelloids = nhs @@ -53,11 +58,15 @@ loadGame stateChange clean = do , wonlost = Nothing } -handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () -handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Pressed) +handleGameKeys + :: Affection UserData () + -> Affection UserData () + -> KeyboardMessage + -> Affection UserData () +handleGameKeys stateChange clean kbdev = + if (msgKbdKeyMotion kbdev == SDL.Pressed) then case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do - liftIO $ logIO A.Debug "PEW!" shoot SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do ud <- getAffection @@ -68,13 +77,11 @@ handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Presse liftIO $ logIO A.Debug "Leave to Menu" stateChange SDL.KeycodeW -> accelShip dVel - -- SDL.KeycodeS -> accelShip (-dVel) SDL.KeycodeA -> rotateShip dRot SDL.KeycodeD -> rotateShip (-dRot) _ -> return () else case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeW -> deThrust - -- SDL.KeycodeS -> deThrust SDL.KeycodeA -> deThrust SDL.KeycodeD -> deThrust _ -> return () @@ -161,12 +168,18 @@ checkShotDown :: Affection UserData () checkShotDown = do ud <- getAffection - let shoots = shots ud + let pews = shots ud hasks = haskelloids ud - pairs = catMaybes $ concatMap (crossOut hasks) shoots + pairs = catMaybes $ concatMap (crossOut hasks) pews deadHasks = map fst pairs - nhask = foldl (\acc a -> filter (\x -> a /= x) acc) hasks deadHasks - npews = foldl (\acc a -> filter (\x -> a /= x) acc) shoots (map snd pairs) + nhask = foldl + (\acc a -> filter (\x -> a /= x) acc) + hasks + deadHasks + npews = foldl + (\acc a -> filter (\x -> a /= x) acc) + pews + (map snd pairs) children <- liftIO $ concat <$> mapM (\Haskelloid{..} -> do n1velx <- randomRIO (-10, 10) n1vely <- randomRIO (-10, 10) @@ -257,10 +270,11 @@ drawShip Ship{..} = do ctx <- nano <$> getAffection liftIO $ do when (sThrust) $ do - let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` CFloat sRot - V2 x1 y1 = pos - (V2 10 0 `rotVec` CFloat sRot) - V2 x2 y2 = pos + (V2 10 0 `rotVec` CFloat sRot) - V2 x3 y3 = pos - (V2 0 25 `rotVec` CFloat sRot) + let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` cRot + V2 x1 y1 = pos - (V2 10 0 `rotVec` cRot) + V2 x2 y2 = pos + (V2 10 0 `rotVec` cRot) + V2 x3 y3 = pos - (V2 0 25 `rotVec` cRot) + cRot = CFloat sRot save ctx grad <- linearGradient ctx px py x3 y3 (rgba 255 128 0 255) (rgba 0 0 0 0) fillPaint ctx grad diff --git a/src/Init.hs b/src/Init.hs index f997455..b6f5baf 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -67,6 +67,7 @@ load = do , sVel = V2 0 0 , sRot = 0 , sImg = fromJust mshipImage + , sThrust = False } , haskelloids = [] , shots = [] diff --git a/src/Main.hs b/src/Main.hs index c8a3001..3210fb5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,9 +2,7 @@ module Main where import Affection as A -import SDL (($=)) import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL import Linear as L @@ -46,19 +44,7 @@ pre :: Affection UserData () pre = do subs <- subsystems <$> getAffection liftIO $ logIO A.Debug "Setting global resize event listener" - _ <- partSubscribe (subWindow subs) $ \msg -> case msg of - MsgWindowResize _ _ (V2 w h) -> do - liftIO $ logIO A.Debug "Window has been resized" - if (fromIntegral w / fromIntegral h) > (800/600) - then do - let nw = floor (fromIntegral h * (800/600) :: Double) - dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double) - GL.viewport $= (GL.Position dw 0, GL.Size nw h) - else do - let nh = floor (fromIntegral w / (800/600) :: Double) - dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double) - GL.viewport $= (GL.Position 0 dh, GL.Size w nh) - _ -> return () + _ <- partSubscribe (subWindow subs) (fitViewport (800/600)) _ <- partSubscribe (subKeyboard subs) $ \kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $ case SDL.keysymKeycode (msgKbdKeysym kbdev) of