From 84413aca9850552dc96e18e2bc30fe9cb5fc9039 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 10 Jan 2018 04:28:26 +0100 Subject: [PATCH] now with thruster --- src/InGame.hs | 41 +++++++++++++++++++++++++++++++++++++---- src/Types.hs | 1 + 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index 3d315b3..f1103b1 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -46,6 +46,7 @@ loadGame stateChange clean = do { sPos = V2 400 300 , sVel = V2 0 0 , sRot = 0 + , sThrust = False } , shots = [] , state = InGame @@ -53,8 +54,8 @@ loadGame stateChange clean = do } handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () -handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ - case SDL.keysymKeycode (msgKbdKeysym kbdev) of +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 @@ -67,10 +68,16 @@ handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pres liftIO $ logIO A.Debug "Leave to Menu" stateChange SDL.KeycodeW -> accelShip dVel - SDL.KeycodeS -> 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 () shoot :: Affection UserData () shoot = do @@ -92,6 +99,16 @@ accelShip vel = do putAffection ud { ship = s { sVel = nVel + , sThrust = True + } + } + +deThrust :: Affection UserData () +deThrust = do + ud <- getAffection + putAffection ud + { ship = (ship ud) + { sThrust = False } } @@ -238,7 +255,23 @@ drawWonLost wl = do drawShip :: Ship -> Affection UserData () drawShip Ship{..} = do ctx <- nano <$> getAffection - liftIO $ drawImage ctx sImg (sPos - fmap (/2) dim) dim sRot 1 + 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) + save ctx + grad <- linearGradient ctx px py x3 y3 (rgba 255 128 0 255) (rgba 0 0 0 0) + fillPaint ctx grad + beginPath ctx + moveTo ctx x1 y1 + lineTo ctx x2 y2 + lineTo ctx x3 y3 + closePath ctx + fill ctx + restore ctx + drawImage ctx sImg (sPos - fmap (/2) dim) dim sRot 1 where dim = V2 40 40 diff --git a/src/Types.hs b/src/Types.hs index 16fab54..d217824 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -28,6 +28,7 @@ data UserData = UserData data Ship = Ship { sPos :: V2 Float , sVel :: V2 Float + , sThrust :: Bool , sRot :: Float , sImg :: Image }