more state machining

This commit is contained in:
nek0 2017-01-02 23:29:32 +01:00
parent 8fc717fd8b
commit 0aff3e84ca
4 changed files with 67 additions and 26 deletions

View file

@ -157,7 +157,7 @@ load _ = do
-- ) [] ([0..9] :: [Int])
-- liftIO $ gegl_node_link_many $ map hFlange hs
-- liftIO $ gegl_node_link (last $ map hFlange hs) hnop
loadMenu $ UserData
return $ UserData
{ nodeGraph = myMap
, ship = Ship
{ sPos = (375, 275)

View file

@ -17,6 +17,7 @@ import Debug.Trace
import Types
import Commons
import Transitions
import Menu
import InGame
@ -26,13 +27,16 @@ main = withAffection $ AffectionConfig
{ initComponents = All
, windowTitle = "Haskelloids"
, windowConfig = defaultWindow
, preLoop = transition
, preLoop = pre
, drawLoop = draw
, updateLoop = update
, loadState = load
, cleanUp = clean
}
pre :: Affection UserData ()
pre = smLoad Menu
update :: Double -> Affection UserData ()
update sec = do
-- traceM $ (show $ 1 / sec) ++ " FPS"
@ -47,10 +51,11 @@ update sec = do
putAffection pd
{ pixelSize = pixelSize wd -1
}
case state wd of
Menu ->
updateMenu sec
_ -> return ()
-- case state wd of
-- Menu ->
-- updateMenu sec
-- _ -> return ()
smUpdate (state wd) sec
evs <- SDL.pollEvents
mapM_ (\e ->
case state wd of

View file

@ -1,3 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-}
module Transitions where
import Affection
@ -5,17 +7,51 @@ import qualified SDL
import GEGL
import BABL
loadMenu :: UserData -> IO UserData
loadMenu ud = do
gegl_node_link (nodeGraph ud M.! KeyMenuOver) (nodeGraph ud M.! KeyFGNop)
hs <- catMaybes <$> foldM (\acc _ -> do
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Control.Monad (foldM)
import System.Random (randomRIO)
import Types
import Commons
instance StateMachine State UserData where
smLoad Menu = do
ud <- getAffection
liftIO $ gegl_node_link
(nodeGraph ud M.! KeyMenuOver)
(nodeGraph ud M.! KeyFGNop)
hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do
px <- randomRIO (0, 800)
py <- randomRIO (0, 600)
insertHaskelloid acc Nothing (px, py)
) [] ([0..9] :: [Int])
liftIO $ gegl_node_link_many $ map hFlange hs
liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop)
return ud
putAffection ud
{ haskelloids = hs
, fade = FadeIn 1
, state = Menu
}
smUpdate Menu sec = do
ud <- getAffection
case fade ud of
FadeIn ttl -> do
liftIO $ gegl_node_set (nodeGraph ud M.! KeyMenuText) $
Operation "gegl:text"
[ Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 (1.1 - ttl)
]
putAffection ud
{ fade = if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1
}
FadeOut ttl -> do
liftIO $ gegl_node_set (nodeGraph ud M.! KeyMenuText) $
Operation "gegl:text"
[ Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 ttl
]
putAffection ud
{ fade = if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1
}

View file

@ -66,13 +66,13 @@ data State
| InGame
class StateMachine a us where
load :: a -> Affection us ()
update :: a -> Affection us ()
draw :: a -> Affection us ()
clean :: a -> Affection us ()
smLoad :: a -> Affection us ()
smUpdate :: a -> Double -> Affection us ()
smDraw :: a -> Affection us ()
smClean :: a -> Affection us ()
instance StateMachine State UserData where
update Menu = return ()
-- instance StateMachine State UserData where
-- update Menu = return ()
data MenuFade