doesn't work either

This commit is contained in:
nek0 2017-11-04 18:28:33 +01:00
parent 7d12975d0c
commit 02242301e2
4 changed files with 22 additions and 18 deletions

View file

@ -24,8 +24,8 @@ clean ud = do
mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud)
gegl_node_drop $ nodeGraph ud M.! KeyRoot
load :: SDL.Surface -> IO UserData
load _ = do
load :: IO UserData
load = do
traceM "loading"
root <- gegl_node_new
traceM "root node"

View file

@ -13,11 +13,12 @@ import Debug.Trace
import Types
import Commons
handleGameEvent :: Double -> SDL.Event -> Affection UserData ()
handleGameEvent sec e = do
handleGameEvent :: SDL.EventPayload -> Affection UserData ()
handleGameEvent e = do
ad <- get
wd <- getAffection
case SDL.eventPayload e of
sec <- getDelta
case e of
SDL.KeyboardEvent dat ->
case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of
SDL.KeycodeLeft -> do
@ -72,14 +73,14 @@ handleGameEvent sec e = do
{ particleTimeToLive = 5
, particleCreation = elapsedTime ad
, particlePosition = (posX, posY)
, particleRotation = Rad 0
, particleRotation = 0
, particleVelocity =
-- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud)))
-- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud)))
( (floor $ -200 * (sin $ toR $ sRot $ ship ud))
, (floor $ -200 * (cos $ toR $ sRot $ ship ud))
)
, particlePitchRate = Rad 0
, particlePitchRate = 0
, particleRootNode = tempRoot
, particleNodeGraph = M.fromList
[ ("root", tempRoot)
@ -97,7 +98,7 @@ handleGameEvent sec e = do
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
liftIO $ traceIO "reloading"
liftIO $ clean wd
nd <- liftIO $ load $ drawSurface ad
nd <- liftIO $ load
putAffection nd
_ -> return ()
SDL.WindowClosedEvent _ -> do

View file

@ -29,6 +29,9 @@ main = withAffection $ AffectionConfig
, updateLoop = update
, loadState = load
, cleanUp = clean
, canvasSize = Nothing
, initScreenMode = SDL.Windowed
, eventLoop = handleGameEvent
}
update :: Double -> Affection UserData ()
@ -45,13 +48,13 @@ update sec = do
putAffection pd
{ pixelSize = pixelSize wd -1
}
evs <- SDL.pollEvents
mapM_ (\e ->
case state wd of
InGame ->
handleGameEvent sec e
_ -> error "not yet implemented"
) evs
-- evs <- SDL.pollEvents
-- mapM_ (\e ->
-- case state wd of
-- InGame ->
-- handleGameEvent e
-- _ -> error "not yet implemented"
-- ) evs
ud2 <- getAffection
nhs <- mapM (updateHaskelloid sec) (haskelloids ud2)
-- liftIO $ traceIO $ show $ length nhs
@ -69,7 +72,7 @@ update sec = do
liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate"
[ Property "degrees" $ PropertyDouble $ sRot $ ship ud3
]
ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw
ups <- updateParticleSystem (shots ud3) sec shotsUpd
ud4 <- getAffection
putAffection ud4
{ ship = (ship ud3)

View file

@ -15,7 +15,7 @@ data UserData = UserData
-- , debris :: ParticleSystem
, wonlost :: Bool
, pixelSize :: Int
, state :: StateMachine
, state :: State
}
data Ship = Ship
@ -52,7 +52,7 @@ data NodeKey
| KeyFGNop
deriving (Ord, Eq)
data StateMachine
data State
= Menu
| HighScore
| InGame