doesn't work either
This commit is contained in:
parent
7d12975d0c
commit
02242301e2
4 changed files with 22 additions and 18 deletions
|
@ -24,8 +24,8 @@ clean ud = do
|
||||||
mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud)
|
mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud)
|
||||||
gegl_node_drop $ nodeGraph ud M.! KeyRoot
|
gegl_node_drop $ nodeGraph ud M.! KeyRoot
|
||||||
|
|
||||||
load :: SDL.Surface -> IO UserData
|
load :: IO UserData
|
||||||
load _ = do
|
load = do
|
||||||
traceM "loading"
|
traceM "loading"
|
||||||
root <- gegl_node_new
|
root <- gegl_node_new
|
||||||
traceM "root node"
|
traceM "root node"
|
||||||
|
|
|
@ -13,11 +13,12 @@ import Debug.Trace
|
||||||
import Types
|
import Types
|
||||||
import Commons
|
import Commons
|
||||||
|
|
||||||
handleGameEvent :: Double -> SDL.Event -> Affection UserData ()
|
handleGameEvent :: SDL.EventPayload -> Affection UserData ()
|
||||||
handleGameEvent sec e = do
|
handleGameEvent e = do
|
||||||
ad <- get
|
ad <- get
|
||||||
wd <- getAffection
|
wd <- getAffection
|
||||||
case SDL.eventPayload e of
|
sec <- getDelta
|
||||||
|
case e of
|
||||||
SDL.KeyboardEvent dat ->
|
SDL.KeyboardEvent dat ->
|
||||||
case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of
|
case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of
|
||||||
SDL.KeycodeLeft -> do
|
SDL.KeycodeLeft -> do
|
||||||
|
@ -72,14 +73,14 @@ handleGameEvent sec e = do
|
||||||
{ particleTimeToLive = 5
|
{ particleTimeToLive = 5
|
||||||
, particleCreation = elapsedTime ad
|
, particleCreation = elapsedTime ad
|
||||||
, particlePosition = (posX, posY)
|
, particlePosition = (posX, posY)
|
||||||
, particleRotation = Rad 0
|
, particleRotation = 0
|
||||||
, particleVelocity =
|
, particleVelocity =
|
||||||
-- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud)))
|
-- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud)))
|
||||||
-- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud)))
|
-- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud)))
|
||||||
( (floor $ -200 * (sin $ toR $ sRot $ ship ud))
|
( (floor $ -200 * (sin $ toR $ sRot $ ship ud))
|
||||||
, (floor $ -200 * (cos $ toR $ sRot $ ship ud))
|
, (floor $ -200 * (cos $ toR $ sRot $ ship ud))
|
||||||
)
|
)
|
||||||
, particlePitchRate = Rad 0
|
, particlePitchRate = 0
|
||||||
, particleRootNode = tempRoot
|
, particleRootNode = tempRoot
|
||||||
, particleNodeGraph = M.fromList
|
, particleNodeGraph = M.fromList
|
||||||
[ ("root", tempRoot)
|
[ ("root", tempRoot)
|
||||||
|
@ -97,7 +98,7 @@ handleGameEvent sec e = do
|
||||||
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
|
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
|
||||||
liftIO $ traceIO "reloading"
|
liftIO $ traceIO "reloading"
|
||||||
liftIO $ clean wd
|
liftIO $ clean wd
|
||||||
nd <- liftIO $ load $ drawSurface ad
|
nd <- liftIO $ load
|
||||||
putAffection nd
|
putAffection nd
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
SDL.WindowClosedEvent _ -> do
|
SDL.WindowClosedEvent _ -> do
|
||||||
|
|
19
src/Main.hs
19
src/Main.hs
|
@ -29,6 +29,9 @@ main = withAffection $ AffectionConfig
|
||||||
, updateLoop = update
|
, updateLoop = update
|
||||||
, loadState = load
|
, loadState = load
|
||||||
, cleanUp = clean
|
, cleanUp = clean
|
||||||
|
, canvasSize = Nothing
|
||||||
|
, initScreenMode = SDL.Windowed
|
||||||
|
, eventLoop = handleGameEvent
|
||||||
}
|
}
|
||||||
|
|
||||||
update :: Double -> Affection UserData ()
|
update :: Double -> Affection UserData ()
|
||||||
|
@ -45,13 +48,13 @@ update sec = do
|
||||||
putAffection pd
|
putAffection pd
|
||||||
{ pixelSize = pixelSize wd -1
|
{ pixelSize = pixelSize wd -1
|
||||||
}
|
}
|
||||||
evs <- SDL.pollEvents
|
-- evs <- SDL.pollEvents
|
||||||
mapM_ (\e ->
|
-- mapM_ (\e ->
|
||||||
case state wd of
|
-- case state wd of
|
||||||
InGame ->
|
-- InGame ->
|
||||||
handleGameEvent sec e
|
-- handleGameEvent e
|
||||||
_ -> error "not yet implemented"
|
-- _ -> error "not yet implemented"
|
||||||
) evs
|
-- ) evs
|
||||||
ud2 <- getAffection
|
ud2 <- getAffection
|
||||||
nhs <- mapM (updateHaskelloid sec) (haskelloids ud2)
|
nhs <- mapM (updateHaskelloid sec) (haskelloids ud2)
|
||||||
-- liftIO $ traceIO $ show $ length nhs
|
-- liftIO $ traceIO $ show $ length nhs
|
||||||
|
@ -69,7 +72,7 @@ update sec = do
|
||||||
liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate"
|
liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate"
|
||||||
[ Property "degrees" $ PropertyDouble $ sRot $ ship ud3
|
[ Property "degrees" $ PropertyDouble $ sRot $ ship ud3
|
||||||
]
|
]
|
||||||
ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw
|
ups <- updateParticleSystem (shots ud3) sec shotsUpd
|
||||||
ud4 <- getAffection
|
ud4 <- getAffection
|
||||||
putAffection ud4
|
putAffection ud4
|
||||||
{ ship = (ship ud3)
|
{ ship = (ship ud3)
|
||||||
|
|
|
@ -15,7 +15,7 @@ data UserData = UserData
|
||||||
-- , debris :: ParticleSystem
|
-- , debris :: ParticleSystem
|
||||||
, wonlost :: Bool
|
, wonlost :: Bool
|
||||||
, pixelSize :: Int
|
, pixelSize :: Int
|
||||||
, state :: StateMachine
|
, state :: State
|
||||||
}
|
}
|
||||||
|
|
||||||
data Ship = Ship
|
data Ship = Ship
|
||||||
|
@ -52,7 +52,7 @@ data NodeKey
|
||||||
| KeyFGNop
|
| KeyFGNop
|
||||||
deriving (Ord, Eq)
|
deriving (Ord, Eq)
|
||||||
|
|
||||||
data StateMachine
|
data State
|
||||||
= Menu
|
= Menu
|
||||||
| HighScore
|
| HighScore
|
||||||
| InGame
|
| InGame
|
||||||
|
|
Loading…
Reference in a new issue