diff --git a/haskelloids.cabal b/haskelloids.cabal index 9f4a275..64a61db 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -56,6 +56,7 @@ executable haskelloids other-modules: InGame , Types , Commons + , Transitions -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Commons.hs b/src/Commons.hs index cc4ba0c..926f0b6 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -174,21 +174,6 @@ load _ = do , state = Menu } -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 - } - insertHaskelloid :: [Maybe Haskelloid] -> Maybe Int -> (Double, Double) -> IO [Maybe Haskelloid] insertHaskelloid hasks split (px, py) = do -- liftIO $ traceIO "inserting haskelloid" diff --git a/src/Main.hs b/src/Main.hs index b900777..dc4eb86 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -26,7 +26,7 @@ main = withAffection $ AffectionConfig { initComponents = All , windowTitle = "Haskelloids" , windowConfig = defaultWindow - , preLoop = return () + , preLoop = transition , drawLoop = draw , updateLoop = update , loadState = load @@ -86,6 +86,9 @@ update sec = do , shots = ups } +transition :: Affection us () +transition = return () + wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) wrapAround (nx, ny) width = (nnx, nny) where diff --git a/src/Transitions.hs b/src/Transitions.hs new file mode 100644 index 0000000..fdf5604 --- /dev/null +++ b/src/Transitions.hs @@ -0,0 +1,21 @@ +module Transitions where + +import Affection +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 + } diff --git a/src/Types.hs b/src/Types.hs index bf6574a..eb42b9e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + module Types where import Affection @@ -15,7 +17,7 @@ data UserData = UserData -- , debris :: ParticleSystem , wonlost :: Bool , pixelSize :: Int - , state :: StateMachine + , state :: State , fade :: MenuFade } @@ -58,11 +60,21 @@ data NodeKey | KeyMenuOver deriving (Ord, Eq) -data StateMachine +data State = Menu | HighScore | InGame +class StateMachine a us where + load :: a -> Affection us () + update :: a -> Affection us () + draw :: a -> Affection us () + clean :: a -> Affection us () + +instance StateMachine State UserData where + update Menu = return () + + data MenuFade = FadeIn Double | FadeOut Double