now with thruster

This commit is contained in:
nek0 2018-01-10 04:28:26 +01:00
parent 70b7fe725f
commit 84413aca98
2 changed files with 38 additions and 4 deletions

View file

@ -46,6 +46,7 @@ loadGame stateChange clean = do
{ sPos = V2 400 300 { sPos = V2 400 300
, sVel = V2 0 0 , sVel = V2 0 0
, sRot = 0 , sRot = 0
, sThrust = False
} }
, shots = [] , shots = []
, state = InGame , state = InGame
@ -53,8 +54,8 @@ loadGame stateChange clean = do
} }
handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData ()
handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Pressed)
case SDL.keysymKeycode (msgKbdKeysym kbdev) of then case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do
liftIO $ logIO A.Debug "PEW!" liftIO $ logIO A.Debug "PEW!"
shoot shoot
@ -67,10 +68,16 @@ handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pres
liftIO $ logIO A.Debug "Leave to Menu" liftIO $ logIO A.Debug "Leave to Menu"
stateChange stateChange
SDL.KeycodeW -> accelShip dVel SDL.KeycodeW -> accelShip dVel
SDL.KeycodeS -> accelShip (-dVel) -- SDL.KeycodeS -> accelShip (-dVel)
SDL.KeycodeA -> rotateShip dRot SDL.KeycodeA -> rotateShip dRot
SDL.KeycodeD -> rotateShip (-dRot) SDL.KeycodeD -> rotateShip (-dRot)
_ -> return () _ -> 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 :: Affection UserData ()
shoot = do shoot = do
@ -92,6 +99,16 @@ accelShip vel = do
putAffection ud putAffection ud
{ ship = s { ship = s
{ sVel = nVel { 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 -> Affection UserData ()
drawShip Ship{..} = do drawShip Ship{..} = do
ctx <- nano <$> getAffection 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 where
dim = V2 40 40 dim = V2 40 40

View file

@ -28,6 +28,7 @@ data UserData = UserData
data Ship = Ship data Ship = Ship
{ sPos :: V2 Float { sPos :: V2 Float
, sVel :: V2 Float , sVel :: V2 Float
, sThrust :: Bool
, sRot :: Float , sRot :: Float
, sImg :: Image , sImg :: Image
} }