a little cleaning

This commit is contained in:
nek0 2018-01-11 08:31:14 +01:00
parent 84413aca98
commit f09b0f5bd0
4 changed files with 32 additions and 31 deletions

View file

@ -67,7 +67,7 @@ executable haskelloids
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: base >=4.9 && <4.11 build-depends: base >=4.9 && <4.11
, affection <= 0.0.0.8 , affection <= 0.0.0.9
, sdl2 >= 2.1.3.1 , sdl2 >= 2.1.3.1
, OpenGL , OpenGL
, containers , containers

View file

@ -33,12 +33,17 @@ pewTTL = 10
dRot :: Float dRot :: Float
dRot = 150 dRot = 150
loadGame :: Affection UserData () -> Affection UserData () -> Affection UserData () loadGame
:: Affection UserData ()
-> Affection UserData ()
-> Affection UserData ()
loadGame stateChange clean = do loadGame stateChange clean = do
liftIO $ logIO A.Debug "loading game" liftIO $ logIO A.Debug "loading game"
ud <- getAffection ud <- getAffection
nhs <- newHaskelloids nhs <- newHaskelloids
kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange clean) kid <- partSubscribe
(subKeyboard $ subsystems ud)
(handleGameKeys stateChange clean)
putAffection ud putAffection ud
{ stateUUIDs = UUIDClean [] [kid] { stateUUIDs = UUIDClean [] [kid]
, haskelloids = nhs , haskelloids = nhs
@ -53,11 +58,15 @@ loadGame stateChange clean = do
, wonlost = Nothing , wonlost = Nothing
} }
handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () handleGameKeys
handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Pressed) :: Affection UserData ()
-> Affection UserData ()
-> KeyboardMessage
-> Affection UserData ()
handleGameKeys stateChange clean kbdev =
if (msgKbdKeyMotion kbdev == SDL.Pressed)
then 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!"
shoot shoot
SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do
ud <- getAffection ud <- getAffection
@ -68,13 +77,11 @@ handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Presse
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.KeycodeA -> rotateShip dRot SDL.KeycodeA -> rotateShip dRot
SDL.KeycodeD -> rotateShip (-dRot) SDL.KeycodeD -> rotateShip (-dRot)
_ -> return () _ -> return ()
else case SDL.keysymKeycode (msgKbdKeysym kbdev) of else case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeW -> deThrust SDL.KeycodeW -> deThrust
-- SDL.KeycodeS -> deThrust
SDL.KeycodeA -> deThrust SDL.KeycodeA -> deThrust
SDL.KeycodeD -> deThrust SDL.KeycodeD -> deThrust
_ -> return () _ -> return ()
@ -161,12 +168,18 @@ checkShotDown :: Affection UserData ()
checkShotDown = checkShotDown =
do do
ud <- getAffection ud <- getAffection
let shoots = shots ud let pews = shots ud
hasks = haskelloids ud hasks = haskelloids ud
pairs = catMaybes $ concatMap (crossOut hasks) shoots pairs = catMaybes $ concatMap (crossOut hasks) pews
deadHasks = map fst pairs deadHasks = map fst pairs
nhask = foldl (\acc a -> filter (\x -> a /= x) acc) hasks deadHasks nhask = foldl
npews = foldl (\acc a -> filter (\x -> a /= x) acc) shoots (map snd pairs) (\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 children <- liftIO $ concat <$> mapM (\Haskelloid{..} -> do
n1velx <- randomRIO (-10, 10) n1velx <- randomRIO (-10, 10)
n1vely <- randomRIO (-10, 10) n1vely <- randomRIO (-10, 10)
@ -257,10 +270,11 @@ drawShip Ship{..} = do
ctx <- nano <$> getAffection ctx <- nano <$> getAffection
liftIO $ do liftIO $ do
when (sThrust) $ do when (sThrust) $ do
let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` CFloat sRot let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` cRot
V2 x1 y1 = pos - (V2 10 0 `rotVec` CFloat sRot) V2 x1 y1 = pos - (V2 10 0 `rotVec` cRot)
V2 x2 y2 = pos + (V2 10 0 `rotVec` CFloat sRot) V2 x2 y2 = pos + (V2 10 0 `rotVec` cRot)
V2 x3 y3 = pos - (V2 0 25 `rotVec` CFloat sRot) V2 x3 y3 = pos - (V2 0 25 `rotVec` cRot)
cRot = CFloat sRot
save ctx save ctx
grad <- linearGradient ctx px py x3 y3 (rgba 255 128 0 255) (rgba 0 0 0 0) grad <- linearGradient ctx px py x3 y3 (rgba 255 128 0 255) (rgba 0 0 0 0)
fillPaint ctx grad fillPaint ctx grad

View file

@ -67,6 +67,7 @@ load = do
, sVel = V2 0 0 , sVel = V2 0 0
, sRot = 0 , sRot = 0
, sImg = fromJust mshipImage , sImg = fromJust mshipImage
, sThrust = False
} }
, haskelloids = [] , haskelloids = []
, shots = [] , shots = []

View file

@ -2,9 +2,7 @@
module Main where module Main where
import Affection as A import Affection as A
import SDL (($=))
import qualified SDL import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
import Linear as L import Linear as L
@ -46,19 +44,7 @@ pre :: Affection UserData ()
pre = do pre = do
subs <- subsystems <$> getAffection subs <- subsystems <$> getAffection
liftIO $ logIO A.Debug "Setting global resize event listener" liftIO $ logIO A.Debug "Setting global resize event listener"
_ <- partSubscribe (subWindow subs) $ \msg -> case msg of _ <- partSubscribe (subWindow subs) (fitViewport (800/600))
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 (subKeyboard subs) $ \kbdev -> _ <- partSubscribe (subKeyboard subs) $ \kbdev ->
when (msgKbdKeyMotion kbdev == SDL.Pressed) $ when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of case SDL.keysymKeycode (msgKbdKeysym kbdev) of