From 5661e72cf2782a550bf6191097db999db3fef293 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 1 Jan 2017 22:58:54 +0100 Subject: [PATCH] stuff --- src/Commons.hs | 73 +++++++++++++++++++++++++++++++++++++++++--------- src/Main.hs | 29 +++++++++++++------- src/Types.hs | 10 +++++++ 3 files changed, 90 insertions(+), 22 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 95486f0..cc4ba0c 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -94,14 +94,42 @@ load _ = do -- vdeg <- gegl_node_new_child root $ Operation "gegl:video-degradation" -- [ Property "pattern" $ PropertyInt 8 -- ] + menuHeading <- gegl_node_new_child root $ textOperation + [ Property "string" $ PropertyString "Haskelloids" + , Property "font" $ PropertyString "Modulo" + , Property "size" $ PropertyDouble 100 + , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 + ] + menuText <- gegl_node_new_child root $ textOperation + [ Property "string" $ PropertyString "Press [Space] to start\nPress [H] for Highscore" + , Property "font" $ PropertyString "Modulo" + , Property "size" $ PropertyDouble 50 + , Property "alignment" $ PropertyInt 1 + , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 + ] + menuTranslateHeading <- gegl_node_new_child root $ Operation "gegl:translate" + [ Property "x" $ PropertyDouble 150 + , Property "y" $ PropertyDouble 100 + , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic + ] + menuTranslateText <- gegl_node_new_child root $ Operation "gegl:translate" + [ Property "x" $ PropertyDouble 130 + , Property "y" $ PropertyDouble 300 + , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic + ] + menuOver <- gegl_node_new_child root $ defaultOverOperation + gegl_node_link menuHeading menuTranslateHeading + gegl_node_link_many [menuText, menuTranslateText, menuOver] + gegl_node_connect_to menuTranslateHeading "output" menuOver "aux" gegl_node_link_many [ship, rotate, translate] gegl_node_link_many [bgover, pover, hover, sover, crop, fgover, pixelize, vignette, sink] - _ <- gegl_node_connect_to translate "output" sover "aux" + -- _ <- gegl_node_connect_to translate "output" sover "aux" _ <- gegl_node_connect_to pnop "output" pover "aux" _ <- gegl_node_connect_to hnop "output" hover "aux" _ <- gegl_node_connect_to bg "output" bgover "aux" - liftIO $ gegl_node_link fgnop fgtranslate - _ <- gegl_node_connect_to fgtranslate "output" fgover "aux" + -- liftIO $ gegl_node_link fgnop fgtranslate + -- _ <- gegl_node_connect_to fgtranslate "output" fgover "aux" + _ <- gegl_node_connect_to fgnop "output" fgover "aux" traceM "nodes complete" myMap <- return $ M.fromList [ (KeyRoot, root) @@ -118,15 +146,18 @@ load _ = do , (KeyPixelize, pixelize) , (KeyFGOver, fgover) , (KeyFGNop, fgnop) + , (KeyMenuHeading, menuTranslateHeading) + , (KeyMenuText, menuText) + , (KeyMenuOver, menuOver) ] - hs <- catMaybes <$> foldM (\acc _ -> do - px <- liftIO $ randomRIO (0, 800) - py <- liftIO $ 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) hnop - return $ UserData + -- hs <- catMaybes <$> foldM (\acc _ -> do + -- px <- liftIO $ randomRIO (0, 800) + -- py <- liftIO $ 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) hnop + loadMenu $ UserData { nodeGraph = myMap , ship = Ship { sPos = (375, 275) @@ -136,10 +167,26 @@ load _ = do } , buffer = buffer , shots = ParticleSystem (ParticleStorage Nothing []) pnop buffer - , haskelloids = hs + -- , haskelloids = hs + , haskelloids = [] , wonlost = False , pixelSize = 3 - , state = InGame + , 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] diff --git a/src/Main.hs b/src/Main.hs index 1a72bce..b900777 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,9 +16,11 @@ import Debug.Trace -- internal imports import Types -import InGame import Commons +import Menu +import InGame + main :: IO () main = withAffection $ AffectionConfig { initComponents = All @@ -45,9 +47,15 @@ update sec = do putAffection pd { pixelSize = pixelSize wd -1 } + case state wd of + Menu -> + updateMenu sec + _ -> return () evs <- SDL.pollEvents mapM_ (\e -> case state wd of + Menu -> + handleMenuEvent sec e InGame -> handleGameEvent sec e _ -> error "not yet implemented" @@ -200,14 +208,17 @@ updateHaskelloid sec h@Haskelloid{..} = do [ Property "degrees" $ PropertyDouble newRot ] ud <- getAffection - lost <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) (100 `div` hDiv) (100 `div` hDiv)) - (GeglRectangle - (floor $ fst $ sPos $ ship ud) - (floor $ snd $ sPos $ ship ud) - 50 - 50 - ) + lost <- + case state ud of + InGame -> liftIO $ gegl_rectangle_intersect + (GeglRectangle (floor nnx) (floor nny) (100 `div` hDiv) (100 `div` hDiv)) + (GeglRectangle + (floor $ fst $ sPos $ ship ud) + (floor $ snd $ sPos $ ship ud) + 50 + 50 + ) + _ -> return Nothing maybe (return ()) (\_ -> lose ) lost diff --git a/src/Types.hs b/src/Types.hs index 88cd3a2..bf6574a 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -16,6 +16,7 @@ data UserData = UserData , wonlost :: Bool , pixelSize :: Int , state :: StateMachine + , fade :: MenuFade } data Ship = Ship @@ -50,9 +51,18 @@ data NodeKey | KeyPixelize | KeyFGOver | KeyFGNop + | KeyMenuHeading + | KeyMenuText + | KeyMenuStart + | KeyMenuHighscore + | KeyMenuOver deriving (Ord, Eq) data StateMachine = Menu | HighScore | InGame + +data MenuFade + = FadeIn Double + | FadeOut Double