make make

haskelloids.cabal

@@ -56,6 +56,7 @@ executable haskelloids
   other-modules:      InGame
                     , Types 
                     , Commons
+                    , Transitions
   
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:    

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"

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

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
+    }

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