diff --git a/src/Commons.hs b/src/Commons.hs index 926f0b6..a243902 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs index dc4eb86..d14d57e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Transitions.hs b/src/Transitions.hs index fdf5604..a561598 100644 --- a/src/Transitions.hs +++ b/src/Transitions.hs @@ -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 - 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 - { haskelloids = hs - , fade = FadeIn 1 - } +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) + 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 + } diff --git a/src/Types.hs b/src/Types.hs index eb42b9e..711fa81 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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