From 5661e72cf2782a550bf6191097db999db3fef293 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 1 Jan 2017 22:58:54 +0100 Subject: [PATCH 01/35] 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 From 8fc717fd8bfcc5d4bf9f97f7d70c5186fe48ba4f Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 2 Jan 2017 16:22:23 +0100 Subject: [PATCH 02/35] make make --- haskelloids.cabal | 1 + src/Commons.hs | 15 --------------- src/Main.hs | 5 ++++- src/Transitions.hs | 21 +++++++++++++++++++++ src/Types.hs | 16 ++++++++++++++-- 5 files changed, 40 insertions(+), 18 deletions(-) create mode 100644 src/Transitions.hs 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 From 0aff3e84ca036f1c46e937fcea754b04fa4fa12b Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 2 Jan 2017 23:29:32 +0100 Subject: [PATCH 03/35] more state machining --- src/Commons.hs | 2 +- src/Main.hs | 15 +++++++---- src/Transitions.hs | 64 ++++++++++++++++++++++++++++++++++++---------- src/Types.hs | 12 ++++----- 4 files changed, 67 insertions(+), 26 deletions(-) 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 From f7d75db28780c986c6a693633f43b8324e571b9a Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 2 Jan 2017 23:49:17 +0100 Subject: [PATCH 04/35] reducing warnings --- src/Commons.hs | 18 +++++++++--------- src/Transitions.hs | 2 -- src/Types.hs | 2 -- 3 files changed, 9 insertions(+), 13 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index a243902..7040d0b 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -6,7 +6,6 @@ import GEGL import BABL import qualified Data.Map as M -import Data.Maybe (catMaybes) import Control.Monad (foldM) @@ -36,7 +35,7 @@ load _ = do , Property "height" $ PropertyDouble 600 , Property "color" $ PropertyColor $ GEGL.RGBA 0 0 0.1 1 ] - ship <- gegl_node_new_child root $ Operation "gegl:svg-load" + shipNode <- gegl_node_new_child root $ Operation "gegl:svg-load" [ Property "path" $ PropertyString "assets/ship.svg" , Property "width" $ PropertyInt 50 , Property "height" $ PropertyInt 50 @@ -68,10 +67,10 @@ load _ = do [ Property "width" $ PropertyDouble 800 , Property "height" $ PropertyDouble 600 ] - buffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 800 600) =<< + nbuffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 800 600) =<< babl_format (PixelFormat BABL.RGBA CFfloat) sink <- gegl_node_new_child root $ Operation "gegl:copy-buffer" - [ Property "buffer" $ PropertyBuffer buffer + [ Property "buffer" $ PropertyBuffer nbuffer ] won <- gegl_node_new_child root $ textOperation [ Property "string" $ PropertyString "YOU WON!" @@ -120,8 +119,8 @@ load _ = do 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_connect_to menuTranslateHeading "output" menuOver "aux" + gegl_node_link_many [shipNode, 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 pnop "output" pover "aux" @@ -135,7 +134,7 @@ load _ = do [ (KeyRoot, root) , (KeyTranslate, translate) , (KeyRotate, rotate) - , (KeyShip, ship) + , (KeyShip, shipNode) , (KeyPNop, pnop) , (KeyHNop, hnop) , (KeyCrop, crop) @@ -165,13 +164,14 @@ load _ = do , sRot = 0 , sFlange = rotate } - , buffer = buffer - , shots = ParticleSystem (ParticleStorage Nothing []) pnop buffer + , buffer = nbuffer + , shots = ParticleSystem (ParticleStorage Nothing []) pnop nbuffer -- , haskelloids = hs , haskelloids = [] , wonlost = False , pixelSize = 3 , state = Menu + , fade = FadeIn 1 } insertHaskelloid :: [Maybe Haskelloid] -> Maybe Int -> (Double, Double) -> IO [Maybe Haskelloid] diff --git a/src/Transitions.hs b/src/Transitions.hs index a561598..d1d51be 100644 --- a/src/Transitions.hs +++ b/src/Transitions.hs @@ -3,9 +3,7 @@ module Transitions where import Affection -import qualified SDL import GEGL -import BABL import qualified Data.Map as M import Data.Maybe (catMaybes) diff --git a/src/Types.hs b/src/Types.hs index 711fa81..7095f1a 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -3,9 +3,7 @@ module Types where import Affection -import qualified SDL import GEGL -import BABL import qualified Data.Map as M data UserData = UserData From eae27cbe15cb8aedf8f24f6a59bb77d0c28b9455 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 3 Jan 2017 00:25:34 +0100 Subject: [PATCH 05/35] state machine --- haskelloids.cabal | 2 +- src/Main.hs | 38 ++++++++++---------------------- src/Transitions.hs | 55 ---------------------------------------------- src/Types.hs | 11 +--------- 4 files changed, 13 insertions(+), 93 deletions(-) delete mode 100644 src/Transitions.hs diff --git a/haskelloids.cabal b/haskelloids.cabal index 64a61db..c8f0f34 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -56,7 +56,7 @@ executable haskelloids other-modules: InGame , Types , Commons - , Transitions + , StateMachine -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Main.hs b/src/Main.hs index d14d57e..92189c6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -17,7 +17,7 @@ import Debug.Trace import Types import Commons -import Transitions +import StateMachine import Menu import InGame @@ -57,14 +57,15 @@ update sec = do -- _ -> return () smUpdate (state wd) sec evs <- SDL.pollEvents - mapM_ (\e -> - case state wd of - Menu -> - handleMenuEvent sec e - InGame -> - handleGameEvent sec e - _ -> error "not yet implemented" - ) evs + -- mapM_ (\e -> + -- case state wd of + -- Menu -> + -- handleMenuEvent sec e + -- InGame -> + -- handleGameEvent sec e + -- _ -> error "not yet implemented" + -- ) evs + mapM_ (smEvent (state wd) sec) evs ud2 <- getAffection nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) -- liftIO $ traceIO $ show $ length nhs @@ -91,9 +92,6 @@ 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 @@ -109,21 +107,7 @@ wrapAround (nx, ny) width = (nnx, nny) draw :: Affection UserData () draw = do ud <- getAffection - liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - -- mintr <- liftIO $ gegl_rectangle_intersect - -- (GeglRectangle 0 0 800 600) - -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) - -- maybe (return ()) (\intr -> - -- present - -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) - -- (buffer ud) - -- False - -- ) mintr - -- XXX: above part crashes regularly for no apparent reason - present - (GeglRectangle 0 0 800 600) - (buffer ud) - True + smDraw $ state ud shotsUpd :: Double -> Particle -> Affection UserData Particle shotsUpd sec part@Particle{..} = do diff --git a/src/Transitions.hs b/src/Transitions.hs deleted file mode 100644 index d1d51be..0000000 --- a/src/Transitions.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} - -module Transitions where - -import Affection -import GEGL - -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 7095f1a..5dfea8a 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -3,6 +3,7 @@ module Types where import Affection +import qualified SDL import GEGL import qualified Data.Map as M @@ -63,16 +64,6 @@ data State | HighScore | InGame -class StateMachine a us where - 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 () - - data MenuFade = FadeIn Double | FadeOut Double From a1c6ce6b92b12cfc9231d2b20b2665d3955a393a Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 3 Jan 2017 17:34:37 +0100 Subject: [PATCH 06/35] works halfway as intended --- src/Commons.hs | 148 +++++++++++++++++++++- src/InGame.hs | 91 +++++++++++++- src/Main.hs | 336 ++++++++++++++++++++++++------------------------- src/Types.hs | 4 +- 4 files changed, 404 insertions(+), 175 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 7040d0b..0a15211 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + module Commons where import Affection @@ -6,8 +8,10 @@ import GEGL import BABL import qualified Data.Map as M +import Data.List (delete) +import Data.Maybe (catMaybes) -import Control.Monad (foldM) +import Control.Monad (foldM, when) import System.Random (randomRIO) @@ -127,14 +131,14 @@ load _ = do _ <- 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" + _ <- 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) - , (KeyTranslate, translate) - , (KeyRotate, rotate) , (KeyShip, shipNode) + , (KeyShipTranslate, translate) + , (KeyShipRotate, rotate) , (KeyPNop, pnop) , (KeyHNop, hnop) , (KeyCrop, crop) @@ -222,3 +226,139 @@ insertHaskelloid hasks split (px, py) = do , ("rot", tempRot) ] } : hasks + +haskelloidShotDown :: Haskelloid -> Affection UserData () +haskelloidShotDown h = do + ud <- getAffection + -- liftIO $ traceIO $ show $ length $ haskelloids ud + let redHaskelloids = delete h (haskelloids ud) + newHaskelloids <- catMaybes <$> foldM + (\acc _ -> + if hDiv h < 4 + then + liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h + else + return $ Nothing : acc + ) + (map Just redHaskelloids) ([0..1] :: [Int]) + liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" + liftIO $ gegl_node_link_many $ map hFlange newHaskelloids + if not $ null newHaskelloids + then + liftIO $ gegl_node_link + (last $ map hFlange newHaskelloids) + (nodeGraph ud M.! KeyHNop) + else do + liftIO $ traceIO "YOU WON!" + liftIO $ gegl_node_link + (nodeGraph ud M.! KeyWon) + (nodeGraph ud M.! KeyFGNop) + putAffection ud + { wonlost = True + } + putAffection ud + { haskelloids = newHaskelloids + } + +updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid +updateHaskelloid sec h@Haskelloid{..} = do + let newX = (fst $ hPos) + sec * (fst $ hVel) + newY = (snd $ hPos) + sec * (snd $ hVel) + newRot = hRot + hPitch * sec + (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) + -- liftIO $ traceIO $ "moving to: " ++ show nnx ++ " " ++ show nny + liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" + [ Property "x" $ PropertyDouble $ nnx + , Property "y" $ PropertyDouble $ nny + ] + liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" + [ Property "degrees" $ PropertyDouble newRot + ] + ud <- getAffection + 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 + return h + { hPos = (nnx, nny) + , hRot = newRot + } + +wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) +wrapAround (nx, ny) width = (nnx, nny) + where + nnx = + if nx > 800 + then nx - (800 + width) + else if nx < -width then nx + 800 + width else nx + nny = + if ny > 600 + then ny - (600 + width) + else if ny < -width then ny + 600 + width else ny + +shotsUpd :: Double -> Particle -> Affection UserData Particle +shotsUpd sec part@Particle{..} = do + let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) + newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) + (nnx, nny) = wrapAround (newX, newY) 4 + liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" + [ Property "x" $ PropertyDouble $ nnx + , Property "y" $ PropertyDouble $ nny + ] + ud <- getAffection + inters <- catMaybes <$> mapM (\h -> do + col <- liftIO $ gegl_rectangle_intersect + (GeglRectangle (floor nnx) (floor nny) 4 4) + (GeglRectangle + (floor $ fst $ hPos h) + (floor $ snd $ hPos h) + (100 `div` hDiv h) + (100 `div` hDiv h) + ) + case col of + Just _ -> return $ Just h + Nothing -> return Nothing + ) (haskelloids ud) + when (not $ null inters) $ + haskelloidShotDown $ head inters + lost <- liftIO $ gegl_rectangle_intersect + (GeglRectangle (floor nnx) (floor nny) 4 4) + (GeglRectangle + (floor $ fst $ sPos $ ship ud) + (floor $ snd $ sPos $ ship ud) + 50 + 50 + ) + maybe (return ()) (\_ -> + lose + ) lost + return part + { particlePosition = (nnx, nny) + , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive + } + +shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () +shotsDraw _ _ _ = return () + +lose :: Affection UserData () +lose = do + ud <- getAffection + liftIO $ traceIO "YOU LOST!" + _ <- liftIO $ gegl_node_link + (nodeGraph ud M.! KeyLost) + (nodeGraph ud M.! KeyFGNop) + putAffection ud + { wonlost = True + } + _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" + return () diff --git a/src/InGame.hs b/src/InGame.hs index e0e86a0..f275b09 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -5,14 +5,103 @@ import qualified SDL import GEGL import qualified Data.Map as M +import Data.Maybe (catMaybes) -import Control.Monad (when) +import Control.Monad (when, foldM) + +import System.Random (randomRIO) import Debug.Trace import Types import Commons +loadGame :: Affection UserData () +loadGame = do + ud <- getAffection + _ <- liftIO $ gegl_node_connect_to + (nodeGraph ud M.! KeyShipTranslate) + "output" + (nodeGraph ud M.! KeyShipOver) + "aux" + hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do + coords <- liftIO excludeShip + insertHaskelloid acc Nothing coords + ) [] ([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 + , wonlost = False + , shots = ParticleSystem + (ParticleStorage Nothing []) + (nodeGraph ud M.! KeyPNop) + (buffer ud) + , ship = Ship + { sPos = (375, 275) + , sVel = (0, 0) + , sRot = 0 + , sFlange = (nodeGraph ud M.! KeyShipRotate) + } + , pixelSize = 3 + , state = InGame + } + +excludeShip :: IO (Double, Double) +excludeShip = do + px <- randomRIO (0, 800) + py <- randomRIO (0, 600) + inter <- gegl_rectangle_intersect + (GeglRectangle px py 100 100) + (GeglRectangle 350 250 100 100) -- Ship's starting position and size + case inter of + Just _ -> + excludeShip + Nothing -> + return (fromIntegral px, fromIntegral py) + +updateGame :: Double -> Affection UserData () +updateGame sec = do + ad <- get + ud <- getAffection + when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize ud > 3) $ do + pd <- getAffection + liftIO $ gegl_node_set (nodeGraph pd M.! KeyPixelize) $ Operation "gegl:pixelize" + [ Property "size-x" $ PropertyInt $ pixelSize pd - 1 + , Property "size-y" $ PropertyInt $ pixelSize pd - 1 + ] + putAffection ud + { pixelSize = pixelSize ud -1 + } + let nx = (fst $ sPos $ ship ud) + (fst $ sVel $ ship ud) * sec + ny = (snd $ sPos $ ship ud) + (snd $ sVel $ ship ud) * sec + (nnx, nny) = wrapAround (nx, ny) 50 + liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipTranslate) $ Operation "gegl:translate" + [ Property "x" $ PropertyDouble $ nnx + , Property "y" $ PropertyDouble $ nny + ] + liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipRotate) $ Operation "gegl:rotate" + [ Property "degrees" $ PropertyDouble $ sRot $ ship ud + ] + td <- getAffection + putAffection td + { ship = (ship ud) + { sPos = (nnx, nny) + } + } + ud2 <- getAffection + nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) + putAffection ud2 + { haskelloids = nhs + } + liftIO $ traceIO $ show $ length nhs + ud3 <- getAffection + ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + ud4 <- getAffection + putAffection ud4 + { shots = ups + } + handleGameEvent :: Double -> SDL.Event -> Affection UserData () handleGameEvent sec e = do ad <- get diff --git a/src/Main.hs b/src/Main.hs index 92189c6..d324c96 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -40,17 +40,17 @@ pre = smLoad Menu update :: Double -> Affection UserData () update sec = do -- traceM $ (show $ 1 / sec) ++ " FPS" - ad <- get + -- ad <- get wd <- getAffection - when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do - liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 - , Property "size-y" $ PropertyInt $ pixelSize wd - 1 - ] - pd <- getAffection - putAffection pd - { pixelSize = pixelSize wd -1 - } + -- when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do + -- liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" + -- [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 + -- , Property "size-y" $ PropertyInt $ pixelSize wd - 1 + -- ] + -- pd <- getAffection + -- putAffection pd + -- { pixelSize = pixelSize wd -1 + -- } -- case state wd of -- Menu -> -- updateMenu sec @@ -66,168 +66,168 @@ update sec = do -- _ -> error "not yet implemented" -- ) evs mapM_ (smEvent (state wd) sec) evs - ud2 <- getAffection - nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - -- liftIO $ traceIO $ show $ length nhs - putAffection ud2 - { haskelloids = nhs - } - ud3 <- getAffection - let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec - ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec - (nnx, nny) = wrapAround (nx, ny) 50 - liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate" - [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 - ] - ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw - ud4 <- getAffection - putAffection ud4 - { ship = (ship ud3) - { sPos = (nnx, nny) - } - , shots = ups - } + -- ud2 <- getAffection + -- nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) + -- -- liftIO $ traceIO $ show $ length nhs + -- putAffection ud2 + -- { haskelloids = nhs + -- } + -- ud3 <- getAffection + -- let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec + -- ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec + -- (nnx, nny) = wrapAround (nx, ny) 50 + -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipTranslate) $ Operation "gegl:translate" + -- [ Property "x" $ PropertyDouble $ nnx + -- , Property "y" $ PropertyDouble $ nny + -- ] + -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipRotate) $ Operation "gegl:rotate" + -- [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 + -- ] + -- ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + -- ud4 <- getAffection + -- putAffection ud4 + -- { ship = (ship ud3) + -- { sPos = (nnx, nny) + -- } + -- , shots = ups + -- } -wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) -wrapAround (nx, ny) width = (nnx, nny) - where - nnx = - if nx > 800 - then nx - (800 + width) - else if nx < -width then nx + 800 + width else nx - nny = - if ny > 600 - then ny - (600 + width) - else if ny < -width then ny + 600 + width else ny +-- wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) +-- wrapAround (nx, ny) width = (nnx, nny) +-- where +-- nnx = +-- if nx > 800 +-- then nx - (800 + width) +-- else if nx < -width then nx + 800 + width else nx +-- nny = +-- if ny > 600 +-- then ny - (600 + width) +-- else if ny < -width then ny + 600 + width else ny draw :: Affection UserData () draw = do ud <- getAffection smDraw $ state ud -shotsUpd :: Double -> Particle -> Affection UserData Particle -shotsUpd sec part@Particle{..} = do - let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) - newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) - (nnx, nny) = wrapAround (newX, newY) 4 - liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - ud <- getAffection - inters <- catMaybes <$> mapM (\h -> do - col <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ hPos h) - (floor $ snd $ hPos h) - (100 `div` hDiv h) - (100 `div` hDiv h) - ) - case col of - Just _ -> return $ Just h - Nothing -> return Nothing - ) (haskelloids ud) - when (not $ null inters) $ - haskelloidShotDown $ head inters - lost <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ sPos $ ship ud) - (floor $ snd $ sPos $ ship ud) - 50 - 50 - ) - maybe (return ()) (\_ -> - lose - ) lost - return part - { particlePosition = (nnx, nny) - , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive - } - -haskelloidShotDown :: Haskelloid -> Affection UserData () -haskelloidShotDown h = do - liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" - ud <- getAffection - let redHaskelloids = delete h (haskelloids ud) - liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" - newHaskelloids <- catMaybes <$> foldM - (\acc _ -> - if hDiv h < 4 - then - liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h - else - return $ Nothing : acc - ) - (map Just redHaskelloids) ([0..1] :: [Int]) - liftIO $ gegl_node_link_many $ map hFlange newHaskelloids - if not $ null newHaskelloids - then - liftIO $ gegl_node_link - (last $ map hFlange newHaskelloids) - (nodeGraph ud M.! KeyHNop) - else do - liftIO $ traceIO "YOU WON!" - liftIO $ gegl_node_link - (nodeGraph ud M.! KeyWon) - (nodeGraph ud M.! KeyFGNop) - putAffection ud - { wonlost = True - } - putAffection ud - { haskelloids = newHaskelloids - } - -shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () -shotsDraw _ _ _ = return () - -updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid -updateHaskelloid sec h@Haskelloid{..} = do - let newX = (fst $ hPos) + sec * (fst $ hVel) - newY = (snd $ hPos) + sec * (snd $ hVel) - newRot = hRot + hPitch * sec - (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) - liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" - [ Property "degrees" $ PropertyDouble newRot - ] - ud <- getAffection - 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 - return h - { hPos = (nnx, nny) - , hRot = newRot - } - -lose :: Affection UserData () -lose = do - ud <- getAffection - liftIO $ traceIO "YOU LOST!" - _ <- liftIO $ gegl_node_link - (nodeGraph ud M.! KeyLost) - (nodeGraph ud M.! KeyFGNop) - putAffection ud - { wonlost = True - } - _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" - return () +-- shotsUpd :: Double -> Particle -> Affection UserData Particle +-- shotsUpd sec part@Particle{..} = do +-- let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) +-- newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) +-- (nnx, nny) = wrapAround (newX, newY) 4 +-- liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" +-- [ Property "x" $ PropertyDouble $ nnx +-- , Property "y" $ PropertyDouble $ nny +-- ] +-- ud <- getAffection +-- inters <- catMaybes <$> mapM (\h -> do +-- col <- liftIO $ gegl_rectangle_intersect +-- (GeglRectangle (floor nnx) (floor nny) 4 4) +-- (GeglRectangle +-- (floor $ fst $ hPos h) +-- (floor $ snd $ hPos h) +-- (100 `div` hDiv h) +-- (100 `div` hDiv h) +-- ) +-- case col of +-- Just _ -> return $ Just h +-- Nothing -> return Nothing +-- ) (haskelloids ud) +-- when (not $ null inters) $ +-- haskelloidShotDown $ head inters +-- lost <- liftIO $ gegl_rectangle_intersect +-- (GeglRectangle (floor nnx) (floor nny) 4 4) +-- (GeglRectangle +-- (floor $ fst $ sPos $ ship ud) +-- (floor $ snd $ sPos $ ship ud) +-- 50 +-- 50 +-- ) +-- maybe (return ()) (\_ -> +-- lose +-- ) lost +-- return part +-- { particlePosition = (nnx, nny) +-- , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive +-- } +-- +-- haskelloidShotDown :: Haskelloid -> Affection UserData () +-- haskelloidShotDown h = do +-- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" +-- ud <- getAffection +-- let redHaskelloids = delete h (haskelloids ud) +-- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" +-- newHaskelloids <- catMaybes <$> foldM +-- (\acc _ -> +-- if hDiv h < 4 +-- then +-- liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h +-- else +-- return $ Nothing : acc +-- ) +-- (map Just redHaskelloids) ([0..1] :: [Int]) +-- liftIO $ gegl_node_link_many $ map hFlange newHaskelloids +-- if not $ null newHaskelloids +-- then +-- liftIO $ gegl_node_link +-- (last $ map hFlange newHaskelloids) +-- (nodeGraph ud M.! KeyHNop) +-- else do +-- liftIO $ traceIO "YOU WON!" +-- liftIO $ gegl_node_link +-- (nodeGraph ud M.! KeyWon) +-- (nodeGraph ud M.! KeyFGNop) +-- putAffection ud +-- { wonlost = True +-- } +-- putAffection ud +-- { haskelloids = newHaskelloids +-- } +-- +-- shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () +-- shotsDraw _ _ _ = return () +-- +-- updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid +-- updateHaskelloid sec h@Haskelloid{..} = do +-- let newX = (fst $ hPos) + sec * (fst $ hVel) +-- newY = (snd $ hPos) + sec * (snd $ hVel) +-- newRot = hRot + hPitch * sec +-- (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) +-- liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" +-- [ Property "x" $ PropertyDouble $ nnx +-- , Property "y" $ PropertyDouble $ nny +-- ] +-- liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" +-- [ Property "degrees" $ PropertyDouble newRot +-- ] +-- ud <- getAffection +-- 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 +-- return h +-- { hPos = (nnx, nny) +-- , hRot = newRot +-- } +-- +-- lose :: Affection UserData () +-- lose = do +-- ud <- getAffection +-- liftIO $ traceIO "YOU LOST!" +-- _ <- liftIO $ gegl_node_link +-- (nodeGraph ud M.! KeyLost) +-- (nodeGraph ud M.! KeyFGNop) +-- putAffection ud +-- { wonlost = True +-- } +-- _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" +-- return () diff --git a/src/Types.hs b/src/Types.hs index 5dfea8a..46cee94 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -39,9 +39,9 @@ data Haskelloid = Haskelloid data NodeKey = KeyRoot - | KeyTranslate - | KeyRotate | KeyShip + | KeyShipTranslate + | KeyShipRotate | KeyPNop | KeyHNop | KeyCrop From b2e622a5c8fc0706ca77feef7aa5504c4b3149c6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 3 Jan 2017 19:36:01 +0100 Subject: [PATCH 07/35] linted --- src/Commons.hs | 66 ++++++++++++++++++++++++-------------------------- src/InGame.hs | 40 +++++++++++++++--------------- src/Main.hs | 4 +-- 3 files changed, 53 insertions(+), 57 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 0a15211..bb38165 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -11,7 +11,7 @@ import qualified Data.Map as M import Data.List (delete) import Data.Maybe (catMaybes) -import Control.Monad (foldM, when) +import Control.Monad (foldM, unless) import System.Random (randomRIO) @@ -24,7 +24,7 @@ toR deg = deg * pi / 180 clean :: UserData -> IO () clean ud = do - mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud) + mapM_ (gegl_node_drop . (\h -> hNodeGraph h M.! "root")) (haskelloids ud) gegl_node_drop $ nodeGraph ud M.! KeyRoot load :: SDL.Surface -> IO UserData @@ -47,11 +47,11 @@ load _ = do pnop <- gegl_node_new_child root $ Operation "gegl:nop" [] hnop <- gegl_node_new_child root $ Operation "gegl:nop" [] fgnop <- gegl_node_new_child root $ Operation "gegl:nop" [] - sover <- gegl_node_new_child root $ defaultOverOperation - hover <- gegl_node_new_child root $ defaultOverOperation - pover <- gegl_node_new_child root $ defaultOverOperation - bgover <- gegl_node_new_child root $ defaultOverOperation - fgover <- gegl_node_new_child root $ defaultOverOperation + sover <- gegl_node_new_child root defaultOverOperation + hover <- gegl_node_new_child root defaultOverOperation + pover <- gegl_node_new_child root defaultOverOperation + bgover <- gegl_node_new_child root defaultOverOperation + fgover <- gegl_node_new_child root defaultOverOperation translate <- gegl_node_new_child root $ Operation "gegl:translate" [ Property "x" $ PropertyDouble 375 , Property "y" $ PropertyDouble 275 @@ -120,7 +120,7 @@ load _ = do , Property "y" $ PropertyDouble 300 , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic ] - menuOver <- gegl_node_new_child root $ defaultOverOperation + 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" @@ -160,7 +160,7 @@ load _ = do -- ) [] ([0..9] :: [Int]) -- liftIO $ gegl_node_link_many $ map hFlange hs -- liftIO $ gegl_node_link (last $ map hFlange hs) hnop - return $ UserData + return UserData { nodeGraph = myMap , ship = Ship { sPos = (375, 275) @@ -188,8 +188,8 @@ insertHaskelloid hasks split (px, py) = do Just x -> return $ x + 1 rot <- liftIO $ randomRIO (0, 360) pitch <- liftIO $ randomRIO (-45, 45) - tempRoot <- liftIO $ gegl_node_new - tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation + tempRoot <- liftIO gegl_node_new + tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation tempSvg <- gegl_node_new_child tempRoot $ Operation "gegl:svg-load" [ Property "path" $ PropertyString "assets/haskelloid.svg" , Property "width" $ PropertyInt (100 `div` rdiv) @@ -262,14 +262,14 @@ haskelloidShotDown h = do updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid updateHaskelloid sec h@Haskelloid{..} = do - let newX = (fst $ hPos) + sec * (fst $ hVel) - newY = (snd $ hPos) + sec * (snd $ hVel) + let newX = fst hPos + sec * fst hVel + newY = snd hPos + sec * snd hVel newRot = hRot + hPitch * sec (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) -- liftIO $ traceIO $ "moving to: " ++ show nnx ++ " " ++ show nny liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" [ Property "degrees" $ PropertyDouble newRot @@ -286,9 +286,7 @@ updateHaskelloid sec h@Haskelloid{..} = do 50 ) _ -> return Nothing - maybe (return ()) (\_ -> - lose - ) lost + maybe (return ()) (const lose) lost return h { hPos = (nnx, nny) , hRot = newRot @@ -297,23 +295,23 @@ updateHaskelloid sec h@Haskelloid{..} = do wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) wrapAround (nx, ny) width = (nnx, nny) where - nnx = - if nx > 800 - then nx - (800 + width) - else if nx < -width then nx + 800 + width else nx - nny = - if ny > 600 - then ny - (600 + width) - else if ny < -width then ny + 600 + width else ny + nnx + | nx > 800 = nx - (800 + width) + | nx < -width = nx + 800 + width + | otherwise = nx + nny + | ny > 600 = ny - (600 + width) + | ny < -width = ny + 600 + width + | otherwise = ny shotsUpd :: Double -> Particle -> Affection UserData Particle shotsUpd sec part@Particle{..} = do - let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) - newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) + let newX = fst particlePosition + sec * fromIntegral (fst particleVelocity) + newY = snd particlePosition + sec * fromIntegral (snd particleVelocity) (nnx, nny) = wrapAround (newX, newY) 4 liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] ud <- getAffection inters <- catMaybes <$> mapM (\h -> do @@ -329,7 +327,7 @@ shotsUpd sec part@Particle{..} = do Just _ -> return $ Just h Nothing -> return Nothing ) (haskelloids ud) - when (not $ null inters) $ + unless (null inters) $ haskelloidShotDown $ head inters lost <- liftIO $ gegl_rectangle_intersect (GeglRectangle (floor nnx) (floor nny) 4 4) @@ -339,12 +337,10 @@ shotsUpd sec part@Particle{..} = do 50 50 ) - maybe (return ()) (\_ -> - lose - ) lost + maybe (return ()) (const lose) lost return part { particlePosition = (nnx, nny) - , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive + , particleTimeToLive = if not $ null inters then 0 else particleTimeToLive } shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () diff --git a/src/InGame.hs b/src/InGame.hs index f275b09..9a9f8c1 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -41,7 +41,7 @@ loadGame = do { sPos = (375, 275) , sVel = (0, 0) , sRot = 0 - , sFlange = (nodeGraph ud M.! KeyShipRotate) + , sFlange = nodeGraph ud M.! KeyShipRotate } , pixelSize = 3 , state = InGame @@ -73,12 +73,12 @@ updateGame sec = do putAffection ud { pixelSize = pixelSize ud -1 } - let nx = (fst $ sPos $ ship ud) + (fst $ sVel $ ship ud) * sec - ny = (snd $ sPos $ ship ud) + (snd $ sVel $ ship ud) * sec + let nx = fst (sPos $ ship ud) + fst (sVel $ ship ud) * sec + ny = snd (sPos $ ship ud) + snd (sVel $ ship ud) * sec (nnx, nny) = wrapAround (nx, ny) 50 liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny + [ Property "x" $ PropertyDouble nnx + , Property "y" $ PropertyDouble nny ] liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipRotate) $ Operation "gegl:rotate" [ Property "degrees" $ PropertyDouble $ sRot $ ship ud @@ -108,13 +108,13 @@ handleGameEvent sec e = do wd <- getAffection case SDL.eventPayload e of SDL.KeyboardEvent dat -> - case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of + case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of SDL.KeycodeLeft -> do ud <- getAffection when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost ud)) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) + 270 * sec + { sRot = sRot (ship ud) + 270 * sec } } SDL.KeycodeRight -> do @@ -122,14 +122,14 @@ handleGameEvent sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) - 270 * sec + { sRot = sRot (ship ud) - 270 * sec } } SDL.KeycodeUp -> when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do ud <- getAffection - let vx = -10 * (sin (toR $ (sRot $ ship ud))) + fst (sVel $ ship ud) - vy = -10 * (cos (toR $ (sRot $ ship ud))) + snd (sVel $ ship ud) + let vx = -10 * sin (toR $ sRot $ ship ud) + fst (sVel $ ship ud) + vy = -10 * cos (toR $ sRot $ ship ud) + snd (sVel $ ship ud) putAffection ud { ship = (ship ud) { sVel = (vx, vy) @@ -144,19 +144,19 @@ handleGameEvent sec e = do , Property "size-y" $ PropertyInt 8 ] -- ad <- get - let posX = (fst $ sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) - posY = (snd $ sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) - tempRoot <- liftIO $ gegl_node_new + let posX = fst (sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) + posY = snd (sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) + tempRoot <- liftIO gegl_node_new tempRect <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ posX - , Property "y" $ PropertyDouble $ posY + [ Property "x" $ PropertyDouble posX + , Property "y" $ PropertyDouble posY , Property "width" $ PropertyDouble 4 , Property "height" $ PropertyDouble 4 - , Property "color" $ PropertyColor $ (GEGL.RGBA 1 1 1 1) + , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 ] - tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation + tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation _ <- liftIO $ gegl_node_connect_to tempRect "output" tempOver "aux" - ips <- insertParticle (shots ud) $ + ips <- insertParticle (shots ud) Particle { particleTimeToLive = 5 , particleCreation = elapsedTime ad @@ -165,8 +165,8 @@ handleGameEvent sec e = do , particleVelocity = -- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud))) -- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud))) - ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) - , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) + ( (floor $ (-200) * (sin $ toR $ sRot $ ship ud)) + , (floor $ (-200) * (cos $ toR $ sRot $ ship ud)) ) , particlePitchRate = Rad 0 , particleRootNode = tempRoot diff --git a/src/Main.hs b/src/Main.hs index d324c96..a9afdf1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import Affection @@ -23,7 +23,7 @@ import Menu import InGame main :: IO () -main = withAffection $ AffectionConfig +main = withAffection AffectionConfig { initComponents = All , windowTitle = "Haskelloids" , windowConfig = defaultWindow From ef6aa711428c708e5b60a98450fed81a8273c0ee Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 12 Jan 2017 18:48:23 +0100 Subject: [PATCH 08/35] blergh --- src/InGame.hs | 18 ++++- src/Main.hs | 192 +++----------------------------------------------- 2 files changed, 25 insertions(+), 185 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index 9a9f8c1..80559fa 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -94,7 +94,7 @@ updateGame sec = do putAffection ud2 { haskelloids = nhs } - liftIO $ traceIO $ show $ length nhs + -- liftIO $ traceIO $ show $ length nhs ud3 <- getAffection ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw ud4 <- getAffection @@ -102,6 +102,22 @@ updateGame sec = do { shots = ups } +drawGame :: Affection UserData () +drawGame = do + ud <- getAffection + liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink + present + (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) + (buffer ud) + False + mapM_ (\h -> do + let s = 100 `div` hDiv h + present + (GeglRectangle (floor $ fst $ hPos h) (floor $ snd $ hPos h) s s) + (buffer ud) + False + ) (haskelloids ud) + handleGameEvent :: Double -> SDL.Event -> Affection UserData () handleGameEvent sec e = do ad <- get diff --git a/src/Main.hs b/src/Main.hs index a9afdf1..4545a72 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -35,199 +35,23 @@ main = withAffection AffectionConfig } pre :: Affection UserData () -pre = smLoad Menu +pre = do + smLoad Menu + -- ud <- getAffection + -- liftIO $ gegl_node_process (nodeGraph ud M.! KeySink) + -- present + -- (GeglRectangle 0 0 800 600) + -- (buffer ud) + -- True update :: Double -> Affection UserData () update sec = do - -- traceM $ (show $ 1 / sec) ++ " FPS" - -- ad <- get wd <- getAffection - -- when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do - -- liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" - -- [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 - -- , Property "size-y" $ PropertyInt $ pixelSize wd - 1 - -- ] - -- pd <- getAffection - -- putAffection pd - -- { pixelSize = pixelSize wd -1 - -- } - -- case state wd of - -- Menu -> - -- updateMenu sec - -- _ -> return () smUpdate (state wd) sec evs <- SDL.pollEvents - -- mapM_ (\e -> - -- case state wd of - -- Menu -> - -- handleMenuEvent sec e - -- InGame -> - -- handleGameEvent sec e - -- _ -> error "not yet implemented" - -- ) evs mapM_ (smEvent (state wd) sec) evs - -- ud2 <- getAffection - -- nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - -- -- liftIO $ traceIO $ show $ length nhs - -- putAffection ud2 - -- { haskelloids = nhs - -- } - -- ud3 <- getAffection - -- let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec - -- ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec - -- (nnx, nny) = wrapAround (nx, ny) 50 - -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipTranslate) $ Operation "gegl:translate" - -- [ Property "x" $ PropertyDouble $ nnx - -- , Property "y" $ PropertyDouble $ nny - -- ] - -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipRotate) $ Operation "gegl:rotate" - -- [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 - -- ] - -- ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw - -- ud4 <- getAffection - -- putAffection ud4 - -- { ship = (ship ud3) - -- { sPos = (nnx, nny) - -- } - -- , shots = ups - -- } - --- wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) --- wrapAround (nx, ny) width = (nnx, nny) --- where --- nnx = --- if nx > 800 --- then nx - (800 + width) --- else if nx < -width then nx + 800 + width else nx --- nny = --- if ny > 600 --- then ny - (600 + width) --- else if ny < -width then ny + 600 + width else ny draw :: Affection UserData () draw = do ud <- getAffection smDraw $ state ud - --- shotsUpd :: Double -> Particle -> Affection UserData Particle --- shotsUpd sec part@Particle{..} = do --- let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) --- newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) --- (nnx, nny) = wrapAround (newX, newY) 4 --- liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- ud <- getAffection --- inters <- catMaybes <$> mapM (\h -> do --- col <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ hPos h) --- (floor $ snd $ hPos h) --- (100 `div` hDiv h) --- (100 `div` hDiv h) --- ) --- case col of --- Just _ -> return $ Just h --- Nothing -> return Nothing --- ) (haskelloids ud) --- when (not $ null inters) $ --- haskelloidShotDown $ head inters --- lost <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ sPos $ ship ud) --- (floor $ snd $ sPos $ ship ud) --- 50 --- 50 --- ) --- maybe (return ()) (\_ -> --- lose --- ) lost --- return part --- { particlePosition = (nnx, nny) --- , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive --- } --- --- haskelloidShotDown :: Haskelloid -> Affection UserData () --- haskelloidShotDown h = do --- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" --- ud <- getAffection --- let redHaskelloids = delete h (haskelloids ud) --- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" --- newHaskelloids <- catMaybes <$> foldM --- (\acc _ -> --- if hDiv h < 4 --- then --- liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h --- else --- return $ Nothing : acc --- ) --- (map Just redHaskelloids) ([0..1] :: [Int]) --- liftIO $ gegl_node_link_many $ map hFlange newHaskelloids --- if not $ null newHaskelloids --- then --- liftIO $ gegl_node_link --- (last $ map hFlange newHaskelloids) --- (nodeGraph ud M.! KeyHNop) --- else do --- liftIO $ traceIO "YOU WON!" --- liftIO $ gegl_node_link --- (nodeGraph ud M.! KeyWon) --- (nodeGraph ud M.! KeyFGNop) --- putAffection ud --- { wonlost = True --- } --- putAffection ud --- { haskelloids = newHaskelloids --- } --- --- shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () --- shotsDraw _ _ _ = return () --- --- updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid --- updateHaskelloid sec h@Haskelloid{..} = do --- let newX = (fst $ hPos) + sec * (fst $ hVel) --- newY = (snd $ hPos) + sec * (snd $ hVel) --- newRot = hRot + hPitch * sec --- (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) --- liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" --- [ Property "degrees" $ PropertyDouble newRot --- ] --- ud <- getAffection --- 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 --- return h --- { hPos = (nnx, nny) --- , hRot = newRot --- } --- --- lose :: Affection UserData () --- lose = do --- ud <- getAffection --- liftIO $ traceIO "YOU LOST!" --- _ <- liftIO $ gegl_node_link --- (nodeGraph ud M.! KeyLost) --- (nodeGraph ud M.! KeyFGNop) --- putAffection ud --- { wonlost = True --- } --- _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" --- return () From 58417742849c0f55ad64bdbd4d88278a6a3e54aa Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 20 Feb 2017 20:21:06 +0100 Subject: [PATCH 09/35] changes in the engine --- haskelloids.cabal | 2 +- src/InGame.hs | 33 ++++++++++++++++++++++++--------- src/Main.hs | 5 ++--- 3 files changed, 27 insertions(+), 13 deletions(-) diff --git a/haskelloids.cabal b/haskelloids.cabal index c8f0f34..9ce4d1e 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -66,7 +66,7 @@ executable haskelloids , affection , gegl , babl - , sdl2 + , sdl2 >= 2.1.3.1 , containers , random diff --git a/src/InGame.hs b/src/InGame.hs index 80559fa..81d8e2f 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -18,18 +18,22 @@ import Commons loadGame :: Affection UserData () loadGame = do + liftIO $ traceIO "loading game" ud <- getAffection _ <- liftIO $ gegl_node_connect_to (nodeGraph ud M.! KeyShipTranslate) "output" (nodeGraph ud M.! KeyShipOver) "aux" + liftIO $ traceIO "nodes connected" hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do coords <- liftIO excludeShip insertHaskelloid acc Nothing coords ) [] ([0..9] :: [Int]) + liftIO $ traceIO "inserted haskelloids" liftIO $ gegl_node_link_many $ map hFlange hs liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop) + liftIO $ traceIO "nodes linked" putAffection ud { haskelloids = hs , wonlost = False @@ -46,6 +50,11 @@ loadGame = do , pixelSize = 3 , state = InGame } + liftIO $ traceIO "game loaded" + present + (GeglRectangle 0 0 800 600) + (buffer ud) + True excludeShip :: IO (Double, Double) excludeShip = do @@ -104,19 +113,25 @@ updateGame sec = do drawGame :: Affection UserData () drawGame = do + -- ud <- getAffection + -- liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink + -- present + -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) + -- (buffer ud) + -- False + -- mapM_ (\h -> do + -- let s = 100 `div` hDiv h + -- present + -- (GeglRectangle (floor $ fst $ hPos h) (floor $ snd $ hPos h) s s) + -- (buffer ud) + -- False + -- ) (haskelloids ud) ud <- getAffection liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink present - (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) + (GeglRectangle 0 0 800 600) (buffer ud) - False - mapM_ (\h -> do - let s = 100 `div` hDiv h - present - (GeglRectangle (floor $ fst $ hPos h) (floor $ snd $ hPos h) s s) - (buffer ud) - False - ) (haskelloids ud) + True handleGameEvent :: Double -> SDL.Event -> Affection UserData () handleGameEvent sec e = do diff --git a/src/Main.hs b/src/Main.hs index 4545a72..deb67b6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -44,11 +44,10 @@ pre = do -- (buffer ud) -- True -update :: Double -> Affection UserData () -update sec = do +update :: Double -> [SDL.Event] -> Affection UserData () +update sec evs = do wd <- getAffection smUpdate (state wd) sec - evs <- SDL.pollEvents mapM_ (smEvent (state wd) sec) evs draw :: Affection UserData () From e2d1bf9042fa21528a0e973e7547e462ef09431d Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 20 Feb 2017 20:51:06 +0100 Subject: [PATCH 10/35] ship missing --- assets/ship.png | Bin 0 -> 4705 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 assets/ship.png diff --git a/assets/ship.png b/assets/ship.png new file mode 100644 index 0000000000000000000000000000000000000000..d247a5361fd24624c84ca40fa21fe4f7fd33e6cf GIT binary patch literal 4705 zcmX9?2UJr_*S+*2kMabm(u*j)NReI=K>|pTB1H&2pco>dDj*052pDQ;QUqy1CG;YQ zQY4|OK{}7FBp@I~+JE`}yVl%UXU~~EXV00rGwUW=nnV9#=3@o`;2)ElMpj^5eqI>q z!MA0?E*h+8gA7b;7{Mok(IWx0nF4P*1Ob5T@p+-b^=#yTATP?;9%cQ&3x#$=dID%P zTF&=AA_(pl=qdLA>77T>;sXGVSra3Dn~;2RK`1K27TY^#I*~2>N|;fW-7-3OdCiHi!0zu)C+{yJZ6KG^@95uUn52OlvZXAlc&ksmm`G5n9Yd9}3cDvI^ZSXK zs@J$-Bw~+OQsrHLeuqhjH+0xGQ8o{sV)DP*?RV}k)Yf&9IewRM&KE^t8u}J~f2GFL zH3IT}sh<}s=|U2suFi{-e}`yMb5czuZr>m)hH6o3naX7936UR$Zu7jNd5dX1z7y_W zs70UiZ(oKRX`@zK$3l=AMIRh*?lfR}wNiz6$WK-b+h)IqUH{n4;w2YE#)X#bscVPQ z2FkpZLd{pVKNsFDW{cPG#|CBX*@O6&(^|V<74IkEGRRJjH{Xu%h+%kpp%$=4f6T7= zK;!}fCe8SnbIN%ql&l!O4a^^oJcO!$tjyr73Db!cBY|k^CA1Z(Y)mvK9o>R%7_^$ zIu%$*@Euykug*VYPY^7tDSPSuoL{9}Sms`|FF`0uZgOW!oz{|Nw4hgmpiw1F=LXPh z;0}}boU~Y}M(ciL+KlDRrYM2_9>u-}k9zcz&Ouds`C6>N zvE6Ruuy8ZWGtiU($s8yjX&CDx{(|1EoW zz98k_A=Gy`Fy1fF`TlEcj7e3Y24B2nIFtaPI}zTPbeN0H;_GD5h4GYsKEH&`ZIheMtQnwYb&z(Bf=ijFr#D>%P0i3Fr$i~QyIs-mWl)R zbFW3{tXA{aDf0EHw;^2WoNrk?7v@8o9G;uMRm@@~q1QWHPRO*HF1{7z@AnXoo_oWphB`MX1G&>Hch%U|2!8}T4 zROLr;9TkFa4JfP1t}}Y;RzX;6(@I|gTO^5K3#saURfi9DBK0%DqB!T(=h%;wPM#7S4^b+o&}I zN*hSxn<4|C{q^}Be|L;8VZVVSu_;0)vM;wLNO{+`5;}>%G^Le*9-I}3&gu@G&`B`xll&0N9 z6HGb|CpUcIziADM@Vj-l5%PeUF635t$2R@gd6bfh0~GA4PhIX#+RAxEFM|Eyc@E`g zqb_QzA~fd_aR`DDF_IgCE-7(>9iCrtXShK?b`*C!9- z{ej>(KlK=bAwovfZ|%b`7tq9kyu0eD;HO`P+<>CbIL`!wrlo$IL#OfNuXUCy&p-yL zkdG=}s)6Nu*cB~%k$rSv{9l7rtmbH<_9z1eIBwc&T~YBc0lBeXY}yd4V=i;~aWYI` znhVzb(ZuWqlA4srAjmv2t_ALS>jsj>s__5pcLIYhdst8BR~KB z5TXt}q?dI*I1aTOzt*z_tbmZYUe>vybu+aT2fF-{4vGU?V7)_w{{?WYz96lmQnt@D z2NvWK4~#G(M5 zVsoI<5I}A|Us33zU^^Nji&-@UK_UO4h}`(dVrJIZ>9&%VQRqax^Nvx#lQ+>~VBX%a zMXC!#Dkyi!fJl^~$Ue?Ta0fhPX~TSu#24r7!Ku7jK0(0_BaXyN=kN7*Tnm%t1E>Q5 zb^R%MUK;568rS{%!#Sw6(N&3>6`YfjLqb!V7dl|B>@p~HTpboE((e8ZJaH3sW(DUR zK%DCp|BG`+IvItOLz)reDP7;ETIWfk;kkzAh~Yw>iON@T&s0AQi?iFnh2}RFS<#1{C(V3OrK&XD6tM6)l9ov8JD0-El;;H(D?cp|}aZf9D$qlta^lT7x5 zwD47YtVA$L3o_*mqZdMM=08)QO@iVhzl(2)><{@#--5v@z$D_Rb`+?K6WbTrzwc}B zf1ubU9`Hex85Ca;V%m}8Qu*y}yC+{zxH$?I(ciJdHx$^0(0M~{qwkKNUQNk*M{xQX zpm!tS?AryMC7lN<|9{#|J$ZQET#yA_T&!$*G;=wE@Rbu zbAn@rnkG`~_NCv)94Bw)Y1Y-IF>735@T}O#xcuI*aWGgq)9TQ)^JN`kw>IJ$bSdE@ z!D=vkyO1S&VIg%{)Jh=Hh*h$+qb!BV$jBozA)hPxjniLKR}Eo?moq4chWQJOvY(Bp zgpwZpP5E_++A>?mx&5~SSxVBFx}|Fl*ASkzDUDyg<2xTzX}At$zkdJq_*+5xO%Jb< zsatW1@*L?TKd2b`is#8sbbT5&*~Ds|;)9BvuH5oSJgjy#5>1aSG|R71 ztm91Ajn$pI+VsUgw}2pN4Pjds$?lg>g7o&cAaR@~x8bg>4n{hh=^qmN>6w!4B}MZ@ z({Dbi>SYkP7Oihs%F3QDB05&BSm!GL3ju32xZ?p+bC#`MuDMrdE`E?YE&p$#jh8<_ zE3#h{>)O+~!2c)h=yccnUyMD`@5uDm-wBpuju4jS9GQ?n&JnI=+K_)k7#0`cf8G_4 z30~L5cuhp&st^iU@AkIt51^>v29zg5!?w(~4VbKRzpO^g@`&95>ZsAwG)j(dX+>^| z%25f@&q~~sug*q(IaK}N#nWShd?{*lkj6$7$)qMKJIFMo9Tn~_i3qxD|4Q}x)YGLD zW0Tyi=LTWUfJD9MvhCW8+I}YKYATJ%HM0ow`kD`3U9>aulx_2K(vE&L%aJhw7U7Z# z(ddxA#~z8q$1%7Nnh^~#y4%zVfMGOmSNUIND`T#@9nEZ{FNE(VcwhOQt`S>jf+o>o zsrWylkCTVTT3wZMx(S|gx<*A#JgLm{x>1ACt2k<9H=IjH}OgSP(ljn z?nn%!vzvGj32(g+h&jB!&e-w*dP7oabk^=&rTD>rN~||GZ*K`a72Y|ap7%_EWinTm zJkJizU0|_DQWP_?@6+6oRRf4)stcEBZ`1=daA#9P3WHLb1Hm1wqAV;}&Dh!AymPNY z#b8VJOh4H|BQLXN=_=0ju2E4oFVKEFF8Z%CACm(e!r zgQ7Fw95q18z4zTstu40~pD`U7sA@NrCsg!vVA}V7qzwEbpAUzz)+fUZ(vvc{P&bVW z!)p|Ep(aopeOH0?B-h5Wo3mW}k+K^VUBs7)6)#;eTjzQ&>IQSi&sCD>!6B3vv-Jco zY_0wWt=Y%8zNuv%TA>|o{f!wXsQh4#Bok~ujtS*zr5^YAhPeg{)NRWFpB06 z?{>g^g>+Sg)Mvn(L*PXlN;Xb8YLY6;Z=vVX5EWvhwRY7v;RBPzQPw3vb7Ex#K zvoc(@yA=LR;G{tN2N0;)or~9`mn}`^Z!W$a&yqKq{LedRjgCn(g4&qJnl?!(H_0Flhn+C5^M8&G#;Kw zP4@=)CqACc6R1>N8j!|epiD7sZg!vVZWzn_CvNWd7V(%!TDf%!349ldp$}x~*6$Qm zf)^z+CWdPj9hmde%dsKv8DoOB(HyHK>BuiF&k#R(>NSYcDTUwY?WfjoiCoAJu@a0Q znew~*y{x&;9KTsaCyhH@u()Ipn6joa|0>}5vW&Md4V<8np14<(60pG!`^WV*Ow~K+ zIwqHJ>cdhtAQ^M*1@ctX$pXnPp3&~czr-FN^1Q;wkUw@Fwc8YdI2~YslCiX_w-Kp- z{JrWsdidU_&b#C`@?x8$pu!Vp(?0y=$x3p|RCw@f(a+;HnqIy@i+jPg5*0PF2 z!;tJT7nLn8I;rvZxL>k1Q{;ztv{e8)W?%S2wl_iUZOl0)a?e;o-?P4=>Aru@ zQ0?UG=}8H9jjsKLj4Q!Gor-*46&4 z)YFa?ZXrPTj$pl1DgZGcRKAkXO9vvOJ7}|;Ua#(%rdCif;@rcTa?C?Y=nv>dTtoc@ dEm+Rj%0q7XPv5v+0{#vHOpMKqa0d5c{tw?&*aH9n literal 0 HcmV?d00001 From 2ff4f617225c5878f09b89ec137d82ffe2b3f91f Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 20 Feb 2017 20:51:33 +0100 Subject: [PATCH 11/35] I forgot to push this --- src/Menu.hs | 19 +++++++++ src/StateMachine.hs | 100 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 119 insertions(+) create mode 100644 src/Menu.hs create mode 100644 src/StateMachine.hs diff --git a/src/Menu.hs b/src/Menu.hs new file mode 100644 index 0000000..6982903 --- /dev/null +++ b/src/Menu.hs @@ -0,0 +1,19 @@ +module Menu where + +import Affection +import qualified SDL + +import Debug.Trace + +import Types + +handleMenuEvent :: Double -> SDL.Event -> Affection UserData () +handleMenuEvent sec e = do + ad <- get + case SDL.eventPayload e of + SDL.WindowClosedEvent _ -> do + traceM "seeya!" + put ad + { quitEvent = True + } + _ -> return () diff --git a/src/StateMachine.hs b/src/StateMachine.hs new file mode 100644 index 0000000..f84bf9b --- /dev/null +++ b/src/StateMachine.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +module StateMachine where + +import Affection +import qualified SDL +import GEGL + +import qualified Data.Map as M +import Data.Maybe (catMaybes) + +import Control.Monad (foldM, when) + +import System.Random (randomRIO) + +import Types +import Commons +import InGame + +class StateMachine a us where + smLoad :: a -> Affection us () + smUpdate :: a -> Double -> Affection us () + smEvent :: a -> Double -> SDL.Event -> Affection us () + smDraw :: a -> Affection us () + smClean :: a -> Affection us () + +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 + } + + smLoad InGame = loadGame + + smUpdate Menu sec = do + ud <- getAffection + nhs <- mapM (updateHaskelloid sec) (haskelloids ud) + 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 + , haskelloids = nhs + } + 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 + , haskelloids = nhs + } + + smUpdate InGame sec = updateGame sec + + smEvent Menu _ e = do + ad <- get + case SDL.eventPayload e of + SDL.KeyboardEvent dat -> + case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of + SDL.KeycodeSpace -> + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do + ud <- getAffection + liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyFGNop) "input" + smLoad InGame + _ -> return () + SDL.WindowClosedEvent _ -> + put ad + { quitEvent = True + } + _ -> return () + + smEvent InGame sec e = handleGameEvent sec e + + smDraw Menu = do + ud <- getAffection + liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink + present + (GeglRectangle 0 0 800 600) + (buffer ud) + True + + smDraw InGame = drawGame From 79642ec557c6b61553caaa81a9c7ea5505b28cbc Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Feb 2017 02:13:58 +0100 Subject: [PATCH 12/35] get the nodes in the right order --- src/Commons.hs | 25 ++++++++++++++++++------- src/InGame.hs | 3 +++ src/StateMachine.hs | 9 +++++++-- src/Types.hs | 1 + 4 files changed, 29 insertions(+), 9 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index bb38165..b3ea430 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -130,8 +130,8 @@ load _ = do _ <- 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 @@ -149,6 +149,7 @@ load _ = do , (KeyPixelize, pixelize) , (KeyFGOver, fgover) , (KeyFGNop, fgnop) + , (KeyFGTrans, fgtranslate) , (KeyMenuHeading, menuTranslateHeading) , (KeyMenuText, menuText) , (KeyMenuOver, menuOver) @@ -250,9 +251,15 @@ haskelloidShotDown h = do (nodeGraph ud M.! KeyHNop) else do liftIO $ traceIO "YOU WON!" - liftIO $ gegl_node_link + _ <- liftIO $ gegl_node_link (nodeGraph ud M.! KeyWon) - (nodeGraph ud M.! KeyFGNop) + (nodeGraph ud M.! KeyFGTrans) + _ <- liftIO $ gegl_node_connect_to + (nodeGraph ud M.! KeyFGTrans) + "output" + (nodeGraph ud M.! KeyFGOver) + "aux" + _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" putAffection ud { wonlost = True } @@ -352,9 +359,13 @@ lose = do liftIO $ traceIO "YOU LOST!" _ <- liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) - (nodeGraph ud M.! KeyFGNop) + (nodeGraph ud M.! KeyFGTrans) + _ <- liftIO $ gegl_node_connect_to + (nodeGraph ud M.! KeyFGTrans) + "output" + (nodeGraph ud M.! KeyFGOver) + "aux" + _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" putAffection ud { wonlost = True } - _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" - return () diff --git a/src/InGame.hs b/src/InGame.hs index 81d8e2f..e711a97 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -33,6 +33,9 @@ loadGame = do liftIO $ traceIO "inserted haskelloids" liftIO $ gegl_node_link_many $ map hFlange hs liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop) + liftIO $ gegl_node_disconnect + (nodeGraph ud M.! KeyFGOver) + "aux" liftIO $ traceIO "nodes linked" putAffection ud { haskelloids = hs diff --git a/src/StateMachine.hs b/src/StateMachine.hs index f84bf9b..36a578f 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -27,9 +27,11 @@ class StateMachine a us where instance StateMachine State UserData where smLoad Menu = do ud <- getAffection - liftIO $ gegl_node_link + liftIO $ gegl_node_connect_to (nodeGraph ud M.! KeyMenuOver) - (nodeGraph ud M.! KeyFGNop) + "output" + (nodeGraph ud M.! KeyFGOver) + "aux" hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do px <- randomRIO (0, 800) py <- randomRIO (0, 600) @@ -37,10 +39,13 @@ instance StateMachine State UserData where ) [] ([0..9] :: [Int]) liftIO $ gegl_node_link_many $ map hFlange hs liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop) + liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyPNop) "input" putAffection ud { haskelloids = hs , fade = FadeIn 1 , state = Menu + , shots = (shots ud) + { partSysParts = ParticleStorage Nothing [] } } smLoad InGame = loadGame diff --git a/src/Types.hs b/src/Types.hs index 46cee94..aaf2717 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -52,6 +52,7 @@ data NodeKey | KeyPixelize | KeyFGOver | KeyFGNop + | KeyFGTrans | KeyMenuHeading | KeyMenuText | KeyMenuStart From e59ecbd1e1ec76dbf7154a1aae6d5af84daf8906 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Feb 2017 02:14:49 +0100 Subject: [PATCH 13/35] fix state fuckup --- src/Commons.hs | 8 ++++++-- src/InGame.hs | 4 +++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index b3ea430..71498cd 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -263,7 +263,8 @@ haskelloidShotDown h = do putAffection ud { wonlost = True } - putAffection ud + ud2 <- getAffection + putAffection ud2 { haskelloids = newHaskelloids } @@ -293,7 +294,10 @@ updateHaskelloid sec h@Haskelloid{..} = do 50 ) _ -> return Nothing - maybe (return ()) (const lose) lost + maybe (return ()) (const $ do + lose + putAffection ud {wonlost = True} + ) lost return h { hPos = (nnx, nny) , hRot = newRot diff --git a/src/InGame.hs b/src/InGame.hs index e711a97..750ea83 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -15,6 +15,7 @@ import Debug.Trace import Types import Commons +import Menu loadGame :: Affection UserData () loadGame = do @@ -103,7 +104,8 @@ updateGame sec = do } ud2 <- getAffection nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - putAffection ud2 + ud3 <- getAffection + putAffection ud3 { haskelloids = nhs } -- liftIO $ traceIO $ show $ length nhs From f155e1832b97af2bd79bab2dda502bd30c79f35a Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Feb 2017 02:15:03 +0100 Subject: [PATCH 14/35] remove old code --- src/InGame.hs | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index 750ea83..586bf56 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -118,19 +118,6 @@ updateGame sec = do drawGame :: Affection UserData () drawGame = do - -- ud <- getAffection - -- liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - -- present - -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) - -- (buffer ud) - -- False - -- mapM_ (\h -> do - -- let s = 100 `div` hDiv h - -- present - -- (GeglRectangle (floor $ fst $ hPos h) (floor $ snd $ hPos h) s s) - -- (buffer ud) - -- False - -- ) (haskelloids ud) ud <- getAffection liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink present From aafbfbbc9f4687acf97bff071bcadc1e0005913a Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Feb 2017 02:15:24 +0100 Subject: [PATCH 15/35] go back to menu after winning or losing the game --- src/InGame.hs | 15 +++++++++------ src/StateMachine.hs | 2 +- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index 586bf56..a1befd2 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -125,8 +125,12 @@ drawGame = do (buffer ud) True -handleGameEvent :: Double -> SDL.Event -> Affection UserData () -handleGameEvent sec e = do +handleGameEvent + :: Affection UserData () + -> Double + -> SDL.Event + -> Affection UserData () +handleGameEvent menuload sec e = do ad <- get wd <- getAffection case SDL.eventPayload e of @@ -206,11 +210,10 @@ handleGameEvent sec e = do , pixelSize = 8 } SDL.KeycodeR -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && wonlost wd) $ do liftIO $ traceIO "reloading" - liftIO $ clean wd - nd <- liftIO $ load $ drawSurface ad - putAffection nd + -- liftIO $ clean wd + menuload _ -> return () SDL.WindowClosedEvent _ -> do traceM "seeya!" diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 36a578f..7a2f16f 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -92,7 +92,7 @@ instance StateMachine State UserData where } _ -> return () - smEvent InGame sec e = handleGameEvent sec e + smEvent InGame sec e = handleGameEvent (smLoad Menu) sec e smDraw Menu = do ud <- getAffection From 9d1bbf33d4e92def6873ae220712b6b9f8870e19 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Feb 2017 11:19:55 +0100 Subject: [PATCH 16/35] ignore profiling data --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 05d4d64..79903a3 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,6 @@ .cabal-sandbox/ cabal.sandbox.config dist/ +*.aux +*.hp +*.ps From e13f5c73019d3242e18bd5d8f01b148aa00c589d Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 1 Mar 2017 17:01:58 +0100 Subject: [PATCH 17/35] no highscore --- src/Commons.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Commons.hs b/src/Commons.hs index 71498cd..7416499 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -104,7 +104,7 @@ load _ = do , 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 "string" $ PropertyString "Press [Space] to start" , Property "font" $ PropertyString "Modulo" , Property "size" $ PropertyDouble 50 , Property "alignment" $ PropertyInt 1 From 662567804d06a1f05a612a5b8cd3fc2812b7d471 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 1 Mar 2017 17:02:08 +0100 Subject: [PATCH 18/35] static turn rate --- src/InGame.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index a1befd2..3fdbad0 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -141,7 +141,7 @@ handleGameEvent menuload sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost ud)) $ putAffection ud { ship = (ship ud) - { sRot = sRot (ship ud) + 270 * sec + { sRot = sRot (ship ud) + 5 } } SDL.KeycodeRight -> do @@ -149,7 +149,7 @@ handleGameEvent menuload sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ putAffection ud { ship = (ship ud) - { sRot = sRot (ship ud) - 270 * sec + { sRot = sRot (ship ud) - 5 } } SDL.KeycodeUp -> From 669d28de0d326061c3a7c6727397a8591d677888 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 4 Nov 2017 16:26:29 +0100 Subject: [PATCH 19/35] progress --- haskelloids.cabal | 2 +- src/Commons.hs | 31 ++++++++++++++++++++----------- src/InGame.hs | 23 ++++++++++------------- src/Main.hs | 40 ++++++++++++++++++---------------------- src/Types.hs | 2 +- 5 files changed, 50 insertions(+), 48 deletions(-) diff --git a/haskelloids.cabal b/haskelloids.cabal index 9f4a275..504b840 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -61,7 +61,7 @@ executable haskelloids -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.9 && <4.10 + build-depends: base >=4.9 && <4.11 , affection , gegl , babl diff --git a/src/Commons.hs b/src/Commons.hs index 95486f0..e724291 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -24,8 +24,8 @@ clean ud = do mapM_ gegl_node_drop $ map (\h -> hNodeGraph h M.! "root") (haskelloids ud) gegl_node_drop $ nodeGraph ud M.! KeyRoot -load :: SDL.Surface -> IO UserData -load _ = do +load :: IO UserData +load = do traceM "loading" root <- gegl_node_new traceM "root node" @@ -86,7 +86,6 @@ load _ = do , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 ] vignette <- gegl_node_new_child root $ Operation "gegl:vignette" [] - -- pixelize <- gegl_node_new_child root $ Operation "gegl:pixelize" pixelize <- gegl_node_new_child root $ Operation "gegl:pixelize" [ Property "size-x" $ PropertyInt 3 , Property "size-y" $ PropertyInt 3 @@ -119,13 +118,16 @@ load _ = do , (KeyFGOver, fgover) , (KeyFGNop, fgnop) ] + traceM "built map" hs <- catMaybes <$> foldM (\acc _ -> do px <- liftIO $ randomRIO (0, 800) py <- liftIO $ randomRIO (0, 600) insertHaskelloid acc Nothing (px, py) ) [] ([0..9] :: [Int]) + traceM "built haskelloids" liftIO $ gegl_node_link_many $ map hFlange hs liftIO $ gegl_node_link (last $ map hFlange hs) hnop + traceM "linking haskelloids and returning UserData" return $ UserData { nodeGraph = myMap , ship = Ship @@ -144,33 +146,40 @@ load _ = do insertHaskelloid :: [Maybe Haskelloid] -> Maybe Int -> (Double, Double) -> IO [Maybe Haskelloid] insertHaskelloid hasks split (px, py) = do - -- liftIO $ traceIO "inserting haskelloid" + liftIO $ traceIO "inserting haskelloid" vx <- liftIO $ randomRIO (-10, 10) vy <- liftIO $ randomRIO (-10, 10) rdiv <- case split of Nothing -> liftIO $ randomRIO (1, 2) Just x -> return $ x + 1 - rot <- liftIO $ randomRIO (0, 360) - pitch <- liftIO $ randomRIO (-45, 45) + rot <- liftIO $ randomRIO ((-180) , 180) + pitch <- liftIO $ randomRIO ((-(pi/2)), pi/2) tempRoot <- liftIO $ gegl_node_new tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation - tempSvg <- gegl_node_new_child tempRoot $ Operation "gegl:svg-load" - [ Property "path" $ PropertyString "assets/haskelloid.svg" - , Property "width" $ PropertyInt (100 `div` rdiv) - , Property "height" $ PropertyInt (100 `div` rdiv) + tempSvg <- gegl_node_new_child tempRoot $ Operation "gegl:png-load" + [ Property "path" $ PropertyString "assets/haskelloid.png" ] + liftIO $ traceIO "svg loaded" + tempScale <- gegl_node_new_child tempRoot $ Operation "gegl:scale-size" + [ Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic + , Property "x" $ PropertyDouble (100 / (fromIntegral rdiv) :: Double) + , Property "y" $ PropertyDouble (100 / (fromIntegral rdiv) :: Double) + ] + liftIO $ traceIO "scaled" tempTrans <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:translate" [ Property "x" $ PropertyDouble $ px + (100 / fromIntegral rdiv / 2) , Property "y" $ PropertyDouble $ py + (100 / fromIntegral rdiv / 2) , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic ] + liftIO $ traceIO "translated" tempRot <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rotate" [ Property "origin-x" $ PropertyDouble (100 / 2 / fromIntegral rdiv) , Property "origin-y" $ PropertyDouble (100 / 2 / fromIntegral rdiv) , Property "degrees" $ PropertyDouble rot , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic ] - liftIO $ gegl_node_link_many [tempSvg, tempRot, tempTrans] + liftIO $ traceIO $ "rotated: " ++ show rot + liftIO $ gegl_node_link_many [tempSvg, tempScale, tempRot, tempTrans] _ <- liftIO $ gegl_node_connect_to tempTrans "output" tempOver "aux" return $ Just Haskelloid { hPos = diff --git a/src/InGame.hs b/src/InGame.hs index e0e86a0..99630fa 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -13,11 +13,12 @@ import Debug.Trace import Types import Commons -handleGameEvent :: Double -> SDL.Event -> Affection UserData () -handleGameEvent sec e = do +handleGameEvent :: SDL.EventPayload -> Affection UserData () +handleGameEvent e = do ad <- get wd <- getAffection - case SDL.eventPayload e of + sec <- getDelta + case e of SDL.KeyboardEvent dat -> case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of SDL.KeycodeLeft -> do @@ -25,7 +26,7 @@ handleGameEvent sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost ud)) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) + 270 * sec + { sRot = (sRot $ ship ud) + 15 * sec } } SDL.KeycodeRight -> do @@ -33,7 +34,7 @@ handleGameEvent sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ putAffection ud { ship = (ship ud) - { sRot = (sRot $ ship ud) - 270 * sec + { sRot = (sRot $ ship ud) - 15 * sec } } SDL.KeycodeUp -> @@ -72,14 +73,12 @@ handleGameEvent sec e = do { particleTimeToLive = 5 , particleCreation = elapsedTime ad , particlePosition = (posX, posY) - , particleRotation = Rad 0 + , particleRotation = 0 , particleVelocity = - -- ( (floor $ -200 * (sin $ toR $ (sRot $ ship ud) + (fst $ sVel $ ship ud))) - -- , (floor $ -200 * (cos $ toR $ (sRot $ ship ud) + (snd $ sVel $ ship ud))) ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) ) - , particlePitchRate = Rad 0 + , particlePitchRate = 0 , particleRootNode = tempRoot , particleNodeGraph = M.fromList [ ("root", tempRoot) @@ -97,12 +96,10 @@ handleGameEvent sec e = do when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do liftIO $ traceIO "reloading" liftIO $ clean wd - nd <- liftIO $ load $ drawSurface ad + nd <- liftIO $ load putAffection nd _ -> return () SDL.WindowClosedEvent _ -> do traceM "seeya!" - put ad - { quitEvent = True - } + quit _ -> return () diff --git a/src/Main.hs b/src/Main.hs index 1a72bce..5c6f1b8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -24,11 +24,14 @@ main = withAffection $ AffectionConfig { initComponents = All , windowTitle = "Haskelloids" , windowConfig = defaultWindow + , initScreenMode = SDL.Windowed , preLoop = return () , drawLoop = draw , updateLoop = update , loadState = load , cleanUp = clean + , canvasSize = Nothing + , eventLoop = handleGameEvent } update :: Double -> Affection UserData () @@ -45,13 +48,13 @@ update sec = do putAffection pd { pixelSize = pixelSize wd -1 } - evs <- SDL.pollEvents - mapM_ (\e -> - case state wd of - InGame -> - handleGameEvent sec e - _ -> error "not yet implemented" - ) evs + -- evs <- SDL.pollEvents + -- mapM_ (\e -> + -- case state wd of + -- InGame -> + -- handleGameEvent sec e + -- _ -> error "not yet implemented" + -- ) evs ud2 <- getAffection nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) -- liftIO $ traceIO $ show $ length nhs @@ -69,7 +72,7 @@ update sec = do liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate" [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 ] - ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + ups <- updateParticleSystem (shots ud3) sec shotsUpd ud4 <- getAffection putAffection ud4 { ship = (ship ud3) @@ -93,21 +96,13 @@ wrapAround (nx, ny) width = (nnx, nny) draw :: Affection UserData () draw = do ud <- getAffection + drawParticleSystem (shots ud) (\_ _ _ -> return()) liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - -- mintr <- liftIO $ gegl_rectangle_intersect - -- (GeglRectangle 0 0 800 600) - -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) - -- maybe (return ()) (\intr -> - -- present - -- (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) - -- (buffer ud) - -- False - -- ) mintr - -- XXX: above part crashes regularly for no apparent reason present (GeglRectangle 0 0 800 600) (buffer ud) True + render Nothing Nothing shotsUpd :: Double -> Particle -> Affection UserData Particle shotsUpd sec part@Particle{..} = do @@ -183,14 +178,15 @@ haskelloidShotDown h = do { haskelloids = newHaskelloids } -shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () -shotsDraw _ _ _ = return () - updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid updateHaskelloid sec h@Haskelloid{..} = do let newX = (fst $ hPos) + sec * (fst $ hVel) newY = (snd $ hPos) + sec * (snd $ hVel) - newRot = hRot + hPitch * sec + rawRot = hRot + hPitch * sec + newRot + | rawRot > 360 = rawRot - 360 + | rawRot < -360 = rawRot + 360 + | otherwise = rawRot (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" [ Property "x" $ PropertyDouble $ nnx diff --git a/src/Types.hs b/src/Types.hs index 88cd3a2..5ca5b7b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,6 +1,6 @@ module Types where -import Affection +import Affection hiding (StateMachine) import qualified SDL import GEGL import BABL From 25d45277a0392624d2c7ae8d4062b4900572d5cf Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 4 Nov 2017 18:13:28 +0100 Subject: [PATCH 20/35] doesn't work --- src/InGame.hs | 3 +- src/Main.hs | 259 ++++++++++++++++++++++---------------------- src/StateMachine.hs | 5 +- 3 files changed, 134 insertions(+), 133 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index 7ba8597..d7688cd 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -110,7 +110,8 @@ updateGame sec = do } -- liftIO $ traceIO $ show $ length nhs ud3 <- getAffection - ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + -- ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw + ups <- updateParticleSystem (shots ud3) sec shotsUpd ud4 <- getAffection putAffection ud4 { shots = ups diff --git a/src/Main.hs b/src/Main.hs index 526d3ac..a026794 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Affection +import Affection hiding (StateMachine(..)) import qualified SDL import GEGL @@ -39,108 +39,107 @@ main = withAffection AffectionConfig update :: Double -> Affection UserData () update sec = do - -- traceM $ (show $ 1 / sec) ++ " FPS" - ad <- get - wd <- getAffection - when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do - liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 - , Property "size-y" $ PropertyInt $ pixelSize wd - 1 - ] - pd <- getAffection - putAffection pd - { pixelSize = pixelSize wd -1 - } - -- evs <- SDL.pollEvents - -- mapM_ (\e -> - -- case state wd of - -- InGame -> - -- handleGameEvent sec e - -- _ -> error "not yet implemented" - -- ) evs - ud2 <- getAffection - nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - -- liftIO $ traceIO $ show $ length nhs - putAffection ud2 - { haskelloids = nhs - } - ud3 <- getAffection - let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec - ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec - (nnx, nny) = wrapAround (nx, ny) 50 - liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyRotate) $ Operation "gegl:rotate" - [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 - ] - ups <- updateParticleSystem (shots ud3) sec shotsUpd - ud4 <- getAffection - putAffection ud4 - { ship = (ship ud3) - { sPos = (nnx, nny) - } - , shots = ups - } + ud <- getAffection + smUpdate (state ud) sec -update :: Double -> [SDL.Event] -> Affection UserData () -update sec evs = do - wd <- getAffection - smUpdate (state wd) sec - mapM_ (smEvent (state wd) sec) evs +-- update sec = do +-- -- traceM $ (show $ 1 / sec) ++ " FPS" +-- ad <- get +-- wd <- getAffection +-- when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do +-- liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" +-- [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 +-- , Property "size-y" $ PropertyInt $ pixelSize wd - 1 +-- ] +-- pd <- getAffection +-- putAffection pd +-- { pixelSize = pixelSize wd -1 +-- } +-- -- evs <- SDL.pollEvents +-- -- mapM_ (\e -> +-- -- case state wd of +-- -- InGame -> +-- -- handleGameEvent sec e +-- -- _ -> error "not yet implemented" +-- -- ) evs +-- ud2 <- getAffection +-- nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) +-- -- liftIO $ traceIO $ show $ length nhs +-- putAffection ud2 +-- { haskelloids = nhs +-- } +-- ud3 <- getAffection +-- let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec +-- ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec +-- (nnx, nny) = wrapAround (nx, ny) 50 +-- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipTranslate) $ Operation "gegl:translate" +-- [ Property "x" $ PropertyDouble $ nnx +-- , Property "y" $ PropertyDouble $ nny +-- ] +-- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipRotate) $ Operation "gegl:rotate" +-- [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 +-- ] +-- ups <- updateParticleSystem (shots ud3) sec shotsUpd +-- ud4 <- getAffection +-- putAffection ud4 +-- { ship = (ship ud3) +-- { sPos = (nnx, nny) +-- } +-- , shots = ups +-- } draw :: Affection UserData () draw = do ud <- getAffection - drawParticleSystem (shots ud) (\_ _ _ -> return()) - liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - present - (GeglRectangle 0 0 800 600) - (buffer ud) - True - render Nothing Nothing + smDraw (state ud) + -- drawParticleSystem (shots ud) (\_ _ _ -> return()) + -- liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink + -- present + -- (GeglRectangle 0 0 800 600) + -- (buffer ud) + -- True + -- render Nothing Nothing -shotsUpd :: Double -> Particle -> Affection UserData Particle -shotsUpd sec part@Particle{..} = do - let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) - newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) - (nnx, nny) = wrapAround (newX, newY) 4 - liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - ud <- getAffection - inters <- catMaybes <$> mapM (\h -> do - col <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ hPos h) - (floor $ snd $ hPos h) - (100 `div` hDiv h) - (100 `div` hDiv h) - ) - case col of - Just _ -> return $ Just h - Nothing -> return Nothing - ) (haskelloids ud) - when (not $ null inters) $ - haskelloidShotDown $ head inters - lost <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ sPos $ ship ud) - (floor $ snd $ sPos $ ship ud) - 50 - 50 - ) - maybe (return ()) (\_ -> - lose - ) lost - return part - { particlePosition = (nnx, nny) - , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive - } +-- shotsUpd :: Double -> Particle -> Affection UserData Particle +-- shotsUpd sec part@Particle{..} = do +-- let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) +-- newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) +-- (nnx, nny) = wrapAround (newX, newY) 4 +-- liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" +-- [ Property "x" $ PropertyDouble $ nnx +-- , Property "y" $ PropertyDouble $ nny +-- ] +-- ud <- getAffection +-- inters <- catMaybes <$> mapM (\h -> do +-- col <- liftIO $ gegl_rectangle_intersect +-- (GeglRectangle (floor nnx) (floor nny) 4 4) +-- (GeglRectangle +-- (floor $ fst $ hPos h) +-- (floor $ snd $ hPos h) +-- (100 `div` hDiv h) +-- (100 `div` hDiv h) +-- ) +-- case col of +-- Just _ -> return $ Just h +-- Nothing -> return Nothing +-- ) (haskelloids ud) +-- when (not $ null inters) $ +-- haskelloidShotDown $ head inters +-- lost <- liftIO $ gegl_rectangle_intersect +-- (GeglRectangle (floor nnx) (floor nny) 4 4) +-- (GeglRectangle +-- (floor $ fst $ sPos $ ship ud) +-- (floor $ snd $ sPos $ ship ud) +-- 50 +-- 50 +-- ) +-- maybe (return ()) (\_ -> +-- lose +-- ) lost +-- return part +-- { particlePosition = (nnx, nny) +-- , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive +-- } haskelloidShotDown :: Haskelloid -> Affection UserData () haskelloidShotDown h = do @@ -175,39 +174,39 @@ haskelloidShotDown h = do { haskelloids = newHaskelloids } -updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid -updateHaskelloid sec h@Haskelloid{..} = do - let newX = (fst $ hPos) + sec * (fst $ hVel) - newY = (snd $ hPos) + sec * (snd $ hVel) - rawRot = hRot + hPitch * sec - newRot - | rawRot > 360 = rawRot - 360 - | rawRot < -360 = rawRot + 360 - | otherwise = rawRot - (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) - liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ nnx - , Property "y" $ PropertyDouble $ nny - ] - liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" - [ 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 - ) - maybe (return ()) (\_ -> - lose - ) lost - return h - { hPos = (nnx, nny) - , hRot = newRot - } +-- updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid +-- updateHaskelloid sec h@Haskelloid{..} = do +-- let newX = (fst $ hPos) + sec * (fst $ hVel) +-- newY = (snd $ hPos) + sec * (snd $ hVel) +-- rawRot = hRot + hPitch * sec +-- newRot +-- | rawRot > 180 = rawRot - 360 +-- | rawRot < -180 = rawRot + 360 +-- | otherwise = rawRot +-- (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) +-- liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" +-- [ Property "x" $ PropertyDouble $ nnx +-- , Property "y" $ PropertyDouble $ nny +-- ] +-- liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" +-- [ 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 +-- ) +-- maybe (return ()) (\_ -> +-- lose +-- ) lost +-- return h +-- { hPos = (nnx, nny) +-- , hRot = newRot +-- } lose :: Affection UserData () lose = do diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 7a2f16f..bec5000 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -2,7 +2,7 @@ module StateMachine where -import Affection +import Affection hiding (StateMachine(..)) import qualified SDL import GEGL @@ -92,7 +92,8 @@ instance StateMachine State UserData where } _ -> return () - smEvent InGame sec e = handleGameEvent (smLoad Menu) sec e + -- smEvent InGame sec e = handleGameEvent (smLoad Menu) sec e + smEvent InGame _ e = handleGameEvent (SDL.eventPayload e) smDraw Menu = do ud <- getAffection From 31fd771e645bf17abe1f93ae72854267e064cbd6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 Dec 2017 11:55:30 +0100 Subject: [PATCH 21/35] initiating rewrite --- haskelloids.cabal | 5 +- src/Commons.hs | 353 +------------------------------------------- src/InGame.hs | 155 ++++++++++--------- src/Init.hs | 81 ++++++++++ src/Main.hs | 237 +++++------------------------ src/Menu.hs | 65 +++++++- src/StateMachine.hs | 84 +---------- src/Types.hs | 55 +++---- 8 files changed, 295 insertions(+), 740 deletions(-) create mode 100644 src/Init.hs diff --git a/haskelloids.cabal b/haskelloids.cabal index c6bd651..cde7cbd 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -57,6 +57,7 @@ executable haskelloids , Types , Commons , StateMachine + , Menu -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -64,11 +65,11 @@ executable haskelloids -- Other library packages from which modules are imported. build-depends: base >=4.9 && <4.11 , affection - , gegl - , babl , sdl2 >= 2.1.3.1 , containers , random + , nanovg + , linear -- Directories containing source files. hs-source-dirs: src diff --git a/src/Commons.hs b/src/Commons.hs index e1fc90e..84719dc 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -9,9 +9,9 @@ import BABL import qualified Data.Map as M import Data.List (delete) -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, isJust) -import Control.Monad (foldM, unless) +import Control.Monad (foldM, unless, when) import System.Random (randomRIO) @@ -22,296 +22,6 @@ import Types toR :: Double -> Double toR deg = deg * pi / 180 -clean :: UserData -> IO () -clean ud = do - mapM_ (gegl_node_drop . (\h -> hNodeGraph h M.! "root")) (haskelloids ud) - gegl_node_drop $ nodeGraph ud M.! KeyRoot - -load :: IO UserData -load = do - traceM "loading" - root <- gegl_node_new - traceM "root node" - bg <- gegl_node_new_child root $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble 0 - , Property "y" $ PropertyDouble 0 - , Property "width" $ PropertyDouble 800 - , Property "height" $ PropertyDouble 600 - , Property "color" $ PropertyColor $ GEGL.RGBA 0 0 0.1 1 - ] - shipNode <- gegl_node_new_child root $ Operation "gegl:svg-load" - [ Property "path" $ PropertyString "assets/ship.svg" - , Property "width" $ PropertyInt 50 - , Property "height" $ PropertyInt 50 - ] - pnop <- gegl_node_new_child root $ Operation "gegl:nop" [] - hnop <- gegl_node_new_child root $ Operation "gegl:nop" [] - fgnop <- gegl_node_new_child root $ Operation "gegl:nop" [] - sover <- gegl_node_new_child root defaultOverOperation - hover <- gegl_node_new_child root defaultOverOperation - pover <- gegl_node_new_child root defaultOverOperation - bgover <- gegl_node_new_child root defaultOverOperation - fgover <- gegl_node_new_child root defaultOverOperation - translate <- gegl_node_new_child root $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble 375 - , Property "y" $ PropertyDouble 275 - , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - ] - fgtranslate <- gegl_node_new_child root $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble 150 - , Property "y" $ PropertyDouble 250 - , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - ] - rotate <- gegl_node_new_child root $ Operation "gegl:rotate" - [ Property "origin-x" $ PropertyDouble 25 - , Property "origin-y" $ PropertyDouble 25 - , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - ] - crop <- gegl_node_new_child root $ Operation "gegl:crop" - [ Property "width" $ PropertyDouble 800 - , Property "height" $ PropertyDouble 600 - ] - nbuffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 800 600) =<< - babl_format (PixelFormat BABL.RGBA CFfloat) - sink <- gegl_node_new_child root $ Operation "gegl:copy-buffer" - [ Property "buffer" $ PropertyBuffer nbuffer - ] - won <- gegl_node_new_child root $ textOperation - [ Property "string" $ PropertyString "YOU WON!" - , Property "font" $ PropertyString "Modulo" - , Property "size" $ PropertyDouble 100 - , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 - ] - lost <- gegl_node_new_child root $ textOperation - [ Property "string" $ PropertyString "YOU LOST!" - , Property "font" $ PropertyString "Modulo" - , Property "size" $ PropertyDouble 100 - , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 - ] - vignette <- gegl_node_new_child root $ Operation "gegl:vignette" [] - pixelize <- gegl_node_new_child root $ Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt 3 - , Property "size-y" $ PropertyInt 3 - ] - -- 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" - , 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 [shipNode, 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 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" - _ <- gegl_node_connect_to fgnop "output" fgover "aux" - traceM "nodes complete" - myMap <- return $ M.fromList - [ (KeyRoot, root) - , (KeyShip, shipNode) - , (KeyShipTranslate, translate) - , (KeyShipRotate, rotate) - , (KeyPNop, pnop) - , (KeyHNop, hnop) - , (KeyCrop, crop) - , (KeyShipOver, sover) - , (KeySink, sink) - , (KeyWon, won) - , (KeyLost, lost) - , (KeyPixelize, pixelize) - , (KeyFGOver, fgover) - , (KeyFGNop, fgnop) - , (KeyFGTrans, fgtranslate) - , (KeyMenuHeading, menuTranslateHeading) - , (KeyMenuText, menuText) - , (KeyMenuOver, menuOver) - ] - traceM "built map" - hs <- catMaybes <$> foldM (\acc _ -> do - px <- liftIO $ randomRIO (0, 800) - py <- liftIO $ randomRIO (0, 600) - insertHaskelloid acc Nothing (px, py) - ) [] ([0..9] :: [Int]) - traceM "built haskelloids" - liftIO $ gegl_node_link_many $ map hFlange hs - liftIO $ gegl_node_link (last $ map hFlange hs) hnop - traceM "linking haskelloids and returning UserData" - return $ UserData - { nodeGraph = myMap - , ship = Ship - { sPos = (375, 275) - , sVel = (0, 0) - , sRot = 0 - , sFlange = rotate - } - , buffer = nbuffer - , shots = ParticleSystem (ParticleStorage Nothing []) pnop nbuffer - -- , haskelloids = hs - , haskelloids = [] - , wonlost = False - , pixelSize = 3 - , state = Menu - , fade = FadeIn 1 - } - -insertHaskelloid :: [Maybe Haskelloid] -> Maybe Int -> (Double, Double) -> IO [Maybe Haskelloid] -insertHaskelloid hasks split (px, py) = do - liftIO $ traceIO "inserting haskelloid" - vx <- liftIO $ randomRIO (-10, 10) - vy <- liftIO $ randomRIO (-10, 10) - rdiv <- case split of - Nothing -> liftIO $ randomRIO (1, 2) - Just x -> return $ x + 1 - rot <- liftIO $ randomRIO ((-180) , 180) - pitch <- liftIO $ randomRIO ((-(pi/2)), pi/2) - tempRoot <- liftIO $ gegl_node_new - tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation - tempSvg <- gegl_node_new_child tempRoot $ Operation "gegl:png-load" - [ Property "path" $ PropertyString "assets/haskelloid.png" - ] - liftIO $ traceIO "svg loaded" - tempScale <- gegl_node_new_child tempRoot $ Operation "gegl:scale-size" - [ Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - , Property "x" $ PropertyDouble (100 / (fromIntegral rdiv) :: Double) - , Property "y" $ PropertyDouble (100 / (fromIntegral rdiv) :: Double) - ] - liftIO $ traceIO "scaled" - tempTrans <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble $ px + (100 / fromIntegral rdiv / 2) - , Property "y" $ PropertyDouble $ py + (100 / fromIntegral rdiv / 2) - , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - ] - liftIO $ traceIO "translated" - tempRot <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rotate" - [ Property "origin-x" $ PropertyDouble (100 / 2 / fromIntegral rdiv) - , Property "origin-y" $ PropertyDouble (100 / 2 / fromIntegral rdiv) - , Property "degrees" $ PropertyDouble rot - , Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic - ] - liftIO $ traceIO $ "rotated: " ++ show rot - liftIO $ gegl_node_link_many [tempSvg, tempScale, tempRot, tempTrans] - _ <- liftIO $ gegl_node_connect_to tempTrans "output" tempOver "aux" - return $ Just Haskelloid - { hPos = - ( px + (100 / 2 / fromIntegral rdiv) - , py + (100 / 2 / fromIntegral rdiv) - ) - , hVel = (vx, vy) - , hRot = rot - , hPitch = pitch - , hDiv = rdiv - , hFlange = tempOver - , hNodeGraph = M.fromList - [ ("root", tempRoot) - , ("over", tempOver) - , ("svg", tempSvg) - , ("trans", tempTrans) - , ("rot", tempRot) - ] - } : hasks - -haskelloidShotDown :: Haskelloid -> Affection UserData () -haskelloidShotDown h = do - ud <- getAffection - -- liftIO $ traceIO $ show $ length $ haskelloids ud - let redHaskelloids = delete h (haskelloids ud) - newHaskelloids <- catMaybes <$> foldM - (\acc _ -> - if hDiv h < 4 - then - liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h - else - return $ Nothing : acc - ) - (map Just redHaskelloids) ([0..1] :: [Int]) - liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" - liftIO $ gegl_node_link_many $ map hFlange newHaskelloids - if not $ null newHaskelloids - then - liftIO $ gegl_node_link - (last $ map hFlange newHaskelloids) - (nodeGraph ud M.! KeyHNop) - else do - liftIO $ traceIO "YOU WON!" - _ <- liftIO $ gegl_node_link - (nodeGraph ud M.! KeyWon) - (nodeGraph ud M.! KeyFGTrans) - _ <- liftIO $ gegl_node_connect_to - (nodeGraph ud M.! KeyFGTrans) - "output" - (nodeGraph ud M.! KeyFGOver) - "aux" - _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" - putAffection ud - { wonlost = True - } - ud2 <- getAffection - putAffection ud2 - { haskelloids = newHaskelloids - } - -updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid -updateHaskelloid sec h@Haskelloid{..} = do - let newX = fst hPos + sec * fst hVel - newY = snd hPos + sec * snd hVel - newRot = hRot + hPitch * sec - (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) - -- liftIO $ traceIO $ "moving to: " ++ show nnx ++ " " ++ show nny - liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble nnx - , Property "y" $ PropertyDouble nny - ] - liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" - [ Property "degrees" $ PropertyDouble newRot - ] - ud <- getAffection - 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 ()) (const $ do - lose - putAffection ud {wonlost = True} - ) lost - return h - { hPos = (nnx, nny) - , hRot = newRot - } - wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) wrapAround (nx, ny) width = (nnx, nny) where @@ -323,62 +33,3 @@ wrapAround (nx, ny) width = (nnx, nny) | ny > 600 = ny - (600 + width) | ny < -width = ny + 600 + width | otherwise = ny - -shotsUpd :: Double -> Particle -> Affection UserData Particle -shotsUpd sec part@Particle{..} = do - let newX = fst particlePosition + sec * fromIntegral (fst particleVelocity) - newY = snd particlePosition + sec * fromIntegral (snd particleVelocity) - (nnx, nny) = wrapAround (newX, newY) 4 - liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble nnx - , Property "y" $ PropertyDouble nny - ] - ud <- getAffection - inters <- catMaybes <$> mapM (\h -> do - col <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ hPos h) - (floor $ snd $ hPos h) - (100 `div` hDiv h) - (100 `div` hDiv h) - ) - case col of - Just _ -> return $ Just h - Nothing -> return Nothing - ) (haskelloids ud) - unless (null inters) $ - haskelloidShotDown $ head inters - lost <- liftIO $ gegl_rectangle_intersect - (GeglRectangle (floor nnx) (floor nny) 4 4) - (GeglRectangle - (floor $ fst $ sPos $ ship ud) - (floor $ snd $ sPos $ ship ud) - 50 - 50 - ) - maybe (return ()) (const lose) lost - return part - { particlePosition = (nnx, nny) - , particleTimeToLive = if not $ null inters then 0 else particleTimeToLive - } - -shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () -shotsDraw _ _ _ = return () - -lose :: Affection UserData () -lose = do - ud <- getAffection - liftIO $ traceIO "YOU LOST!" - _ <- liftIO $ gegl_node_link - (nodeGraph ud M.! KeyLost) - (nodeGraph ud M.! KeyFGTrans) - _ <- liftIO $ gegl_node_connect_to - (nodeGraph ud M.! KeyFGTrans) - "output" - (nodeGraph ud M.! KeyFGOver) - "aux" - _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" - putAffection ud - { wonlost = True - } diff --git a/src/InGame.hs b/src/InGame.hs index d7688cd..5a5979c 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -5,7 +5,7 @@ import qualified SDL import GEGL import qualified Data.Map as M -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, isJust, fromJust, isNothing) import Control.Monad (when, foldM) @@ -40,7 +40,7 @@ loadGame = do liftIO $ traceIO "nodes linked" putAffection ud { haskelloids = hs - , wonlost = False + , wonlost = Nothing , shots = ParticleSystem (ParticleStorage Nothing []) (nodeGraph ud M.! KeyPNop) @@ -108,11 +108,10 @@ updateGame sec = do putAffection ud3 { haskelloids = nhs } - -- liftIO $ traceIO $ show $ length nhs ud3 <- getAffection - -- ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw ups <- updateParticleSystem (shots ud3) sec shotsUpd ud4 <- getAffection + when (isJust $ wonlost ud3) (winlose $ fromJust $ wonlost ud3) putAffection ud4 { shots = ups } @@ -136,81 +135,99 @@ handleGameEvent e = do case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of SDL.KeycodeLeft -> do ud <- getAffection - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost ud)) $ - putAffection ud - { ship = (ship ud) - { sRot = (sRot $ ship ud) + 15 * sec + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed + && (isNothing $ wonlost ud)) $ do + let rawRot = (sRot $ ship ud) + 15 * sec + newRot + | rawRot > 360 = rawRot - 360 + | rawRot < 0 = rawRot + 360 + | otherwise = rawRot + putAffection ud + { ship = (ship ud) + { sRot = newRot + } } - } SDL.KeycodeRight -> do ud <- getAffection - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ - putAffection ud - { ship = (ship ud) - { sRot = (sRot $ ship ud) - 15 * sec + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed + && (isNothing $ wonlost ud)) $ do + let rawRot = (sRot $ ship ud) - 15 * sec + newRot + | rawRot > 360 = rawRot - 360 + | rawRot < 0 = rawRot + 360 + | otherwise = rawRot + putAffection ud + { ship = (ship ud) + { sRot = newRot + } } - } SDL.KeycodeUp -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do - ud <- getAffection - let vx = -10 * sin (toR $ sRot $ ship ud) + fst (sVel $ ship ud) - vy = -10 * cos (toR $ sRot $ ship ud) + snd (sVel $ ship ud) - putAffection ud - { ship = (ship ud) - { sVel = (vx, vy) + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed + && (isNothing $ wonlost wd)) $ do + ud <- getAffection + let vx = -10 * sin (toR $ sRot $ ship ud) + fst (sVel $ ship ud) + vy = -10 * cos (toR $ sRot $ ship ud) + snd (sVel $ ship ud) + putAffection ud + { ship = (ship ud) + { sVel = (vx, vy) + } } - } - -- traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud) + -- traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud) SDL.KeycodeSpace -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && not (wonlost wd)) $ do - ud <- getAffection - liftIO $ gegl_node_set (nodeGraph ud M.! KeyPixelize) $ Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt 8 - , Property "size-y" $ PropertyInt 8 - ] - -- ad <- get - let posX = fst (sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) - posY = snd (sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) - tempRoot <- liftIO gegl_node_new - tempRect <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble posX - , Property "y" $ PropertyDouble posY - , Property "width" $ PropertyDouble 4 - , Property "height" $ PropertyDouble 4 - , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 - ] - tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation - _ <- liftIO $ gegl_node_connect_to tempRect "output" tempOver "aux" - ips <- insertParticle (shots ud) - Particle - { particleTimeToLive = 5 - , particleCreation = elapsedTime ad - , particlePosition = (posX, posY) - , particleRotation = 0 - , particleVelocity = - ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) - , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) - ) - , particlePitchRate = 0 - , particleRootNode = tempRoot - , particleNodeGraph = M.fromList - [ ("root", tempRoot) - , ("over", tempOver) - , ("rect", tempRect) + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed + && (isNothing $ wonlost wd)) $ do + ud <- getAffection + liftIO $ gegl_node_set (nodeGraph ud M.! KeyPixelize) $ + Operation "gegl:pixelize" + [ Property "size-x" $ PropertyInt 8 + , Property "size-y" $ PropertyInt 8 ] - , particleStackCont = tempOver - , particleDrawFlange = tempOver + -- ad <- get + let posX = fst (sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) + posY = snd (sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) + tempRoot <- liftIO gegl_node_new + tempRect <- liftIO $ gegl_node_new_child tempRoot $ + Operation "gegl:rectangle" + [ Property "x" $ PropertyDouble posX + , Property "y" $ PropertyDouble posY + , Property "width" $ PropertyDouble 4 + , Property "height" $ PropertyDouble 4 + , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 + ] + tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation + _ <- liftIO $ gegl_node_connect_to tempRect "output" tempOver "aux" + ips <- insertParticle (shots ud) + Particle + { particleTimeToLive = 5 + , particleCreation = elapsedTime ad + , particlePosition = (posX, posY) + , particleRotation = 0 + , particleVelocity = + ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) + , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) + ) + , particlePitchRate = 0 + , particleRootNode = tempRoot + , particleNodeGraph = M.fromList + [ ("root", tempRoot) + , ("over", tempOver) + , ("rect", tempRect) + ] + , particleStackCont = tempOver + , particleDrawFlange = tempOver + } + putAffection $ ud + { shots = ips + , pixelSize = 8 } - putAffection $ ud - { shots = ips - , pixelSize = 8 - } SDL.KeycodeR -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed && wonlost wd) $ do - liftIO $ traceIO "reloading" - liftIO $ clean wd - nd <- liftIO $ load - putAffection nd + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed + && isJust (wonlost wd)) $ do + liftIO $ traceIO "reloading" + liftIO $ clean wd + nd <- liftIO $ load + putAffection nd + loadGame _ -> return () SDL.WindowClosedEvent _ -> do traceM "seeya!" diff --git a/src/Init.hs b/src/Init.hs new file mode 100644 index 0000000..c52add6 --- /dev/null +++ b/src/Init.hs @@ -0,0 +1,81 @@ +module Init where + +import Affection + +import SDL (($=)) +import qualified SDL + +import qualified Data.Set as S +import Data.Maybe + +import System.Random + +import NanoVG + +-- Internal imports + +import Types + +load :: IO UserData +load = do + nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) + mhaskImage <- createImage nvgCtx "assets/haskelloid.svg" 0 + mshipImage <- createImage nvgCtx "assets/ship.svg" 0 + when (isNothing mhasImage || isNothing mshipImage) $ + logIO Error "Failed loading image assets" + hasks <- mapM (\_ -> do + posx <- randomRIO (0, 800) + posy <- randomRIO (0, 600) + velx <- randomRIO (-10, 10) + vely <- randomRIO (-10, 10) + rot <- randomRIO (0, 2*pi) + pitch <- randomRIO (-pi, pi) + div <- randomRIO (1, 2) + return Haskelloid + (V2 posx posy) + (V2 velx vely) + rot + pitch + div + (fromJust mhaskImage) + ) [1..10] + return UserData + { ship = Ship + { sPos = V2 400 300 + , sVel = V2 0 0 + , sRot = 0 + , sImg = fromust mshipImage + } + , haskelloids = [] + , wonlost = Nothing + , state = Menu + , fade = FadeIn 1 + , nano = nvgCtx + } + + + + -- _ <- SDL.setMouseLocationMode SDL.RelativeLocation + -- GL.depthFunc $= ust GL.Less + -- pane <- GL.genObjectName + -- GL.BindVertexArrayObject $= Just pane + -- verts <- GL.genObejctName + -- let vertCoord = + -- [ (-1), (-1), 0 + -- , 1 , (-1), 0 + -- , (-1), 1 , 0 + -- , 1 , 1 , 0 + -- , (-1), 1 , 0 + -- , 1 , (-1), 0 + -- ] + -- withArray vertCoord $ \ptr + -- GL.bufferData GL.ArrayBuffer $= + -- ( fromIntegral $ length vertCoord * 3 * sizeOf (0 :: Double) + -- , ptr + -- , GL.StaticDraw + -- ) + -- GL.vertexAttribPointer (GL.AttribLocation 0) $= + -- ( GL.ToFloat + -- , GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0) + -- ) + -- GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled diff --git a/src/Main.hs b/src/Main.hs index a026794..b519552 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,222 +1,63 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Affection hiding (StateMachine(..)) +import Affection +import SDL (($=)) import qualified SDL -import GEGL -import Data.List (delete) +import qualified Graphics.Rendering.OpenGL as GL +import qualified Graphics.GLUtil as GLU + import qualified Data.Map as M -import Data.Maybe (catMaybes) -import Control.Monad (when, foldM) - -import Debug.Trace +import Linear as L -- internal imports import Types import Commons -import StateMachine - -import Menu -import InGame +import StateMachine () +import Init main :: IO () -main = withAffection AffectionConfig - { initComponents = All - , windowTitle = "Haskelloids" - , windowConfig = defaultWindow - , initScreenMode = SDL.Windowed - , preLoop = return () - , drawLoop = draw - , updateLoop = update - , loadState = load - , cleanUp = clean - , canvasSize = Nothing - , eventLoop = handleGameEvent - } +main = do + logIO Debug "Starting" + withAffection AffectionConfig + { initComponents = All + , windowTitle = "Haskelloids" + , windowConfig = defaultWindow + { SDL.windowOpenGL = Just SDL.defaultOpenGL + { SDL.glProfile = SDL.Core SDL.Normal 3 3 + } + } + , initScreenMode = SDL.Windowed + , canvasSize = Nothing + , loadState = load + , preLoop = smLoad Menu + , eventLoop = handle + , updateLoop = update + , drawLoop = draw + , cleanUp = clean + } update :: Double -> Affection UserData () update sec = do ud <- getAffection smUpdate (state ud) sec --- update sec = do --- -- traceM $ (show $ 1 / sec) ++ " FPS" --- ad <- get --- wd <- getAffection --- when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do --- liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" --- [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 --- , Property "size-y" $ PropertyInt $ pixelSize wd - 1 --- ] --- pd <- getAffection --- putAffection pd --- { pixelSize = pixelSize wd -1 --- } --- -- evs <- SDL.pollEvents --- -- mapM_ (\e -> --- -- case state wd of --- -- InGame -> --- -- handleGameEvent sec e --- -- _ -> error "not yet implemented" --- -- ) evs --- ud2 <- getAffection --- nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) --- -- liftIO $ traceIO $ show $ length nhs --- putAffection ud2 --- { haskelloids = nhs --- } --- ud3 <- getAffection --- let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec --- ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec --- (nnx, nny) = wrapAround (nx, ny) 50 --- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipTranslate) $ Operation "gegl:translate" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipRotate) $ Operation "gegl:rotate" --- [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 --- ] --- ups <- updateParticleSystem (shots ud3) sec shotsUpd --- ud4 <- getAffection --- putAffection ud4 --- { ship = (ship ud3) --- { sPos = (nnx, nny) --- } --- , shots = ups --- } +handle :: SDL.EventPayload -> Affection UserData () +handle e = do + ud <- getAffection + smEvent (state ud) e draw :: Affection UserData () draw = do + GL.viewport $= (GL.Position 0 0, GL.Size 800 600) ud <- getAffection - smDraw (state ud) - -- drawParticleSystem (shots ud) (\_ _ _ -> return()) - -- liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - -- present - -- (GeglRectangle 0 0 800 600) - -- (buffer ud) - -- True - -- render Nothing Nothing - --- shotsUpd :: Double -> Particle -> Affection UserData Particle --- shotsUpd sec part@Particle{..} = do --- let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) --- newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) --- (nnx, nny) = wrapAround (newX, newY) 4 --- liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- ud <- getAffection --- inters <- catMaybes <$> mapM (\h -> do --- col <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ hPos h) --- (floor $ snd $ hPos h) --- (100 `div` hDiv h) --- (100 `div` hDiv h) --- ) --- case col of --- Just _ -> return $ Just h --- Nothing -> return Nothing --- ) (haskelloids ud) --- when (not $ null inters) $ --- haskelloidShotDown $ head inters --- lost <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ sPos $ ship ud) --- (floor $ snd $ sPos $ ship ud) --- 50 --- 50 --- ) --- maybe (return ()) (\_ -> --- lose --- ) lost --- return part --- { particlePosition = (nnx, nny) --- , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive --- } - -haskelloidShotDown :: Haskelloid -> Affection UserData () -haskelloidShotDown h = do - liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" - ud <- getAffection - let redHaskelloids = delete h (haskelloids ud) - liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" - newHaskelloids <- catMaybes <$> foldM - (\acc _ -> - if hDiv h < 4 - then - liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h - else - return $ Nothing : acc - ) - (map Just redHaskelloids) ([0..1] :: [Int]) - liftIO $ gegl_node_link_many $ map hFlange newHaskelloids - if not $ null newHaskelloids - then - liftIO $ gegl_node_link - (last $ map hFlange newHaskelloids) - (nodeGraph ud M.! KeyHNop) - else do - liftIO $ traceIO "YOU WON!" - liftIO $ gegl_node_link - (nodeGraph ud M.! KeyWon) - (nodeGraph ud M.! KeyFGNop) - putAffection ud - { wonlost = True - } - putAffection ud - { haskelloids = newHaskelloids - } - --- updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid --- updateHaskelloid sec h@Haskelloid{..} = do --- let newX = (fst $ hPos) + sec * (fst $ hVel) --- newY = (snd $ hPos) + sec * (snd $ hVel) --- rawRot = hRot + hPitch * sec --- newRot --- | rawRot > 180 = rawRot - 360 --- | rawRot < -180 = rawRot + 360 --- | otherwise = rawRot --- (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) --- liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" --- [ 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 --- ) --- maybe (return ()) (\_ -> --- lose --- ) lost --- return h --- { hPos = (nnx, nny) --- , hRot = newRot --- } - -lose :: Affection UserData () -lose = do - ud <- getAffection - liftIO $ traceIO "YOU LOST!" - _ <- liftIO $ gegl_node_link - (nodeGraph ud M.! KeyLost) - (nodeGraph ud M.! KeyFGNop) - putAffection ud - { wonlost = True - } - _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" - return () + GL.currentProgram $= (Just . GLU.program $ program sd) + let proj = ortho (-1) 1 (-1) 1 (-1) 1 + view = lookAt + (V3 0 0 (-1)) + (V3 0 0 0) + (V3 0 1 0) + model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) diff --git a/src/Menu.hs b/src/Menu.hs index 6982903..f8bd123 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -7,13 +7,68 @@ import Debug.Trace import Types -handleMenuEvent :: Double -> SDL.Event -> Affection UserData () -handleMenuEvent sec e = do - ad <- get - case SDL.eventPayload e of +handleMenuEvent :: SDL.EventPayload -> Affection UserData () +handleMenuEvent e = + case e of + SDL.KeyboardEvent dat -> + case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of + SDL.KeycodeSpace -> + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do + ud <- getAffection + liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyFGNop) "input" + smLoad InGame + _ -> return () SDL.WindowClosedEvent _ -> do - traceM "seeya!" + ad <- get put ad { quitEvent = True } _ -> return () + +loadMenu :: Affection UserData () +loadMenu = do + ud <- getAffection + liftIO $ gegl_node_connect_to + (nodeGraph ud M.! KeyMenuOver) + "output" + (nodeGraph ud M.! KeyFGOver) + "aux" + 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) + -- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyPNop) "input" + putAffection ud + { haskelloids = hs + , fade = FadeIn 1 + , state = Menu + , shots = (shots ud) + { partSysParts = ParticleStorage Nothing [] } + } + +updateMenu :: Double -> Affection UserData () +updateMenu sec = do + ud <- getAffection + nhs <- mapM (updateHaskelloid sec) (haskelloids ud) + 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 + , haskelloids = nhs + } + 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 + , haskelloids = nhs + } diff --git a/src/StateMachine.hs b/src/StateMachine.hs index bec5000..ee8ce2e 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -2,7 +2,7 @@ module StateMachine where -import Affection hiding (StateMachine(..)) +import Affection import qualified SDL import GEGL @@ -16,91 +16,21 @@ import System.Random (randomRIO) import Types import Commons import InGame - -class StateMachine a us where - smLoad :: a -> Affection us () - smUpdate :: a -> Double -> Affection us () - smEvent :: a -> Double -> SDL.Event -> Affection us () - smDraw :: a -> Affection us () - smClean :: a -> Affection us () +import Menu instance StateMachine State UserData where - smLoad Menu = do - ud <- getAffection - liftIO $ gegl_node_connect_to - (nodeGraph ud M.! KeyMenuOver) - "output" - (nodeGraph ud M.! KeyFGOver) - "aux" - 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) - liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyPNop) "input" - putAffection ud - { haskelloids = hs - , fade = FadeIn 1 - , state = Menu - , shots = (shots ud) - { partSysParts = ParticleStorage Nothing [] } - } + smLoad Menu = loadMenu smLoad InGame = loadGame - smUpdate Menu sec = do - ud <- getAffection - nhs <- mapM (updateHaskelloid sec) (haskelloids ud) - 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 - , haskelloids = nhs - } - 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 - , haskelloids = nhs - } + smUpdate Menu = updateMenu smUpdate InGame sec = updateGame sec - smEvent Menu _ e = do - ad <- get - case SDL.eventPayload e of - SDL.KeyboardEvent dat -> - case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of - SDL.KeycodeSpace -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do - ud <- getAffection - liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyFGNop) "input" - smLoad InGame - _ -> return () - SDL.WindowClosedEvent _ -> - put ad - { quitEvent = True - } - _ -> return () + smEvent Menu = handleMenuEvent - -- smEvent InGame sec e = handleGameEvent (smLoad Menu) sec e - smEvent InGame _ e = handleGameEvent (SDL.eventPayload e) + smEvent InGame = handleGameEvent - smDraw Menu = do - ud <- getAffection - liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - present - (GeglRectangle 0 0 800 600) - (buffer ud) - True + smDraw Menu = return () smDraw InGame = drawGame diff --git a/src/Types.hs b/src/Types.hs index 14bd4c3..4a65d8e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -2,64 +2,38 @@ module Types where -import Affection hiding (StateMachine) +import Affection import qualified SDL -import GEGL -import qualified Data.Map as M +import NanoVG data UserData = UserData - { nodeGraph :: M.Map NodeKey GeglNode - , ship :: Ship - , buffer :: GeglBuffer + { ship :: Ship , haskelloids :: [Haskelloid] - , shots :: ParticleSystem + -- , shots :: ParticleSystem -- , debris :: ParticleSystem - , wonlost :: Bool + , wonlost :: Maybe WonLost , pixelSize :: Int , state :: State , fade :: MenuFade + , neno :: Context } data Ship = Ship - { sPos :: (Double, Double) - , sVel :: (Double, Double) + { sPos :: V2 Double + , sVel :: V2 Double , sRot :: Double - , sFlange :: GeglNode + , sImg :: Image } data Haskelloid = Haskelloid - { hPos :: (Double, Double) - , hVel :: (Double, Double) + { hPos :: V2 Double + , hVel :: V2 Double , hRot :: Double , hPitch :: Double , hDiv :: Int - , hFlange :: GeglNode - , hNodeGraph :: M.Map String GeglNode + , hImg :: Image } deriving (Eq) -data NodeKey - = KeyRoot - | KeyShip - | KeyShipTranslate - | KeyShipRotate - | KeyPNop - | KeyHNop - | KeyCrop - | KeyShipOver - | KeySink - | KeyWon - | KeyLost - | KeyPixelize - | KeyFGOver - | KeyFGNop - | KeyFGTrans - | KeyMenuHeading - | KeyMenuText - | KeyMenuStart - | KeyMenuHighscore - | KeyMenuOver - deriving (Ord, Eq) - data State = Menu | HighScore @@ -68,3 +42,8 @@ data State data MenuFade = FadeIn Double | FadeOut Double + +data WonLost + = Won + | Lost + deriving (Eq) From ca52ea7752b44cf4529cc6e0785f97e8b71d86f0 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 Dec 2017 19:06:36 +0100 Subject: [PATCH 22/35] making rewrite --- .gitignore | 2 ++ cabal.config | 1 + haskelloids.cabal | 5 +-- src/Commons.hs | 32 +++++++++++++++-- src/Init.hs | 35 +++++++------------ src/Main.hs | 28 +++++++-------- src/Menu.hs | 84 ++++++++++++++++++++++----------------------- src/StateMachine.hs | 13 ++++--- src/Types.hs | 5 +-- 9 files changed, 111 insertions(+), 94 deletions(-) create mode 100644 cabal.config diff --git a/.gitignore b/.gitignore index 79903a3..c720a2c 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ .cabal-sandbox/ cabal.sandbox.config dist/ +*.prof *.aux *.hp *.ps +*.swp diff --git a/cabal.config b/cabal.config new file mode 100644 index 0000000..2544e4b --- /dev/null +++ b/cabal.config @@ -0,0 +1 @@ +constraints: affection +debug diff --git a/haskelloids.cabal b/haskelloids.cabal index cde7cbd..cc314a1 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -53,12 +53,13 @@ executable haskelloids ghc-options: -Wall -- Modules included in this executable, other than Main. - other-modules: InGame - , Types + other-modules: Types , Commons , StateMachine , Menu + , Init + default-extensions: OverloadedStrings -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Commons.hs b/src/Commons.hs index 84719dc..ff60770 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -4,18 +4,19 @@ module Commons where import Affection import qualified SDL -import GEGL -import BABL import qualified Data.Map as M import Data.List (delete) import Data.Maybe (catMaybes, isJust) import Control.Monad (foldM, unless, when) +import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) -import Debug.Trace +import NanoVG hiding (V2(..)) + +import Linear import Types @@ -33,3 +34,28 @@ wrapAround (nx, ny) width = (nnx, nny) | ny > 600 = ny - (600 + width) | ny < -width = ny + 600 + width | otherwise = ny + +newHaskelloids :: Image -> Affection UserData [Haskelloid] +newHaskelloids img = liftIO $ mapM (\_ -> do + posx <- randomRIO (0, 800) + posy <- randomRIO (0, 600) + velx <- randomRIO (-10, 10) + vely <- randomRIO (-10, 10) + rot <- randomRIO (0, 2*pi) + pitch <- randomRIO (-pi, pi) + div <- randomRIO (1, 2) + return $ Haskelloid + (V2 posx posy) + (V2 velx vely) + rot + pitch + div + img + ) [1..10] + +updateHaskelloid :: Double -> Haskelloid -> Haskelloid +updateHaskelloid sec has = + has + { hPos = hPos has + hVel has * V2 sec sec + , hRot = hRot has + hPitch has * sec + } diff --git a/src/Init.hs b/src/Init.hs index c52add6..d3cd264 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -1,6 +1,6 @@ module Init where -import Affection +import Affection as A import SDL (($=)) import qualified SDL @@ -8,9 +8,14 @@ import qualified SDL import qualified Data.Set as S import Data.Maybe +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) + import System.Random -import NanoVG +import NanoVG hiding (V2(..)) + +import Linear -- Internal imports @@ -18,33 +23,19 @@ import Types load :: IO UserData load = do + liftIO $ logIO A.Debug "loading state" + liftIO $ logIO A.Debug "creating NanoVG context" nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) - mhaskImage <- createImage nvgCtx "assets/haskelloid.svg" 0 - mshipImage <- createImage nvgCtx "assets/ship.svg" 0 - when (isNothing mhasImage || isNothing mshipImage) $ + liftIO $ logIO A.Debug "load ship image" + mshipImage <- createImage nvgCtx (FileName "assets/ship.svg") 0 + when (isNothing mshipImage) $ logIO Error "Failed loading image assets" - hasks <- mapM (\_ -> do - posx <- randomRIO (0, 800) - posy <- randomRIO (0, 600) - velx <- randomRIO (-10, 10) - vely <- randomRIO (-10, 10) - rot <- randomRIO (0, 2*pi) - pitch <- randomRIO (-pi, pi) - div <- randomRIO (1, 2) - return Haskelloid - (V2 posx posy) - (V2 velx vely) - rot - pitch - div - (fromJust mhaskImage) - ) [1..10] return UserData { ship = Ship { sPos = V2 400 300 , sVel = V2 0 0 , sRot = 0 - , sImg = fromust mshipImage + , sImg = fromJust mshipImage } , haskelloids = [] , wonlost = Nothing diff --git a/src/Main.hs b/src/Main.hs index b519552..c132847 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,9 +5,6 @@ import Affection import SDL (($=)) import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL -import qualified Graphics.GLUtil as GLU - import qualified Data.Map as M import Linear as L @@ -25,7 +22,7 @@ main = do withAffection AffectionConfig { initComponents = All , windowTitle = "Haskelloids" - , windowConfig = defaultWindow + , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 3 } @@ -37,7 +34,7 @@ main = do , eventLoop = handle , updateLoop = update , drawLoop = draw - , cleanUp = clean + , cleanUp = (\_ -> return ()) } update :: Double -> Affection UserData () @@ -45,19 +42,20 @@ update sec = do ud <- getAffection smUpdate (state ud) sec -handle :: SDL.EventPayload -> Affection UserData () +handle :: [SDL.EventPayload] -> Affection UserData () handle e = do ud <- getAffection smEvent (state ud) e draw :: Affection UserData () draw = do - GL.viewport $= (GL.Position 0 0, GL.Size 800 600) - ud <- getAffection - GL.currentProgram $= (Just . GLU.program $ program sd) - let proj = ortho (-1) 1 (-1) 1 (-1) 1 - view = lookAt - (V3 0 0 (-1)) - (V3 0 0 0) - (V3 0 1 0) - model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) + return () + -- GL.viewport $= (GL.Position 0 0, GL.Size 800 600) + -- ud <- getAffection + -- GL.currentProgram $= (Just . GLU.program $ program sd) + -- let proj = ortho (-1) 1 (-1) 1 (-1) 1 + -- view = lookAt + -- (V3 0 0 (-1)) + -- (V3 0 0 0) + -- (V3 0 1 0) + -- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) diff --git a/src/Menu.hs b/src/Menu.hs index f8bd123..389ee59 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -1,73 +1,71 @@ module Menu where -import Affection +import Affection as A import qualified SDL import Debug.Trace -import Types +import Data.Maybe -handleMenuEvent :: SDL.EventPayload -> Affection UserData () -handleMenuEvent e = - case e of - SDL.KeyboardEvent dat -> - case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of - SDL.KeycodeSpace -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do - ud <- getAffection - liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyFGNop) "input" - smLoad InGame - _ -> return () - SDL.WindowClosedEvent _ -> do - ad <- get - put ad - { quitEvent = True - } - _ -> return () +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) + +import qualified Data.Map as M + +import NanoVG + +-- internal imports + +import Types +import Commons + +handleMenuEvent :: (Affection UserData ()) -> [SDL.EventPayload] -> Affection UserData () +handleMenuEvent loader es = + mapM_ (\e -> + case e of + SDL.KeyboardEvent dat -> + case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of + SDL.KeycodeSpace -> + when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do + ud <- getAffection + loader + _ -> return () + SDL.WindowClosedEvent _ -> do + ad <- get + put ad + { quitEvent = True + } + _ -> return () + ) es loadMenu :: Affection UserData () loadMenu = do + liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection - liftIO $ gegl_node_connect_to - (nodeGraph ud M.! KeyMenuOver) - "output" - (nodeGraph ud M.! KeyFGOver) - "aux" - 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) - -- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyPNop) "input" + mhaskImage <- liftIO $ + createImage (nano ud) (FileName "assets/haskelloid.svg") 0 + when (isNothing mhaskImage) $ + liftIO $ logIO Error "Failed to load asset haskelloid" + hs <- newHaskelloids (fromJust mhaskImage) putAffection ud { haskelloids = hs , fade = FadeIn 1 , state = Menu - , shots = (shots ud) - { partSysParts = ParticleStorage Nothing [] } + -- , shots = (shots ud) + -- { partSysParts = ParticleStorage Nothing [] } } updateMenu :: Double -> Affection UserData () updateMenu sec = do ud <- getAffection - nhs <- mapM (updateHaskelloid sec) (haskelloids ud) + let nhs = map (updateHaskelloid sec) (haskelloids ud) 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 , haskelloids = nhs } 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 , haskelloids = nhs diff --git a/src/StateMachine.hs b/src/StateMachine.hs index ee8ce2e..5aad6ca 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -4,7 +4,6 @@ module StateMachine where import Affection import qualified SDL -import GEGL import qualified Data.Map as M import Data.Maybe (catMaybes) @@ -15,22 +14,22 @@ import System.Random (randomRIO) import Types import Commons -import InGame +-- import InGame import Menu instance StateMachine State UserData where smLoad Menu = loadMenu - smLoad InGame = loadGame + -- smLoad InGame = loadGame smUpdate Menu = updateMenu - smUpdate InGame sec = updateGame sec + -- smUpdate InGame sec = updateGame sec - smEvent Menu = handleMenuEvent + smEvent Menu = handleMenuEvent (return ()) -- (smLoad InGame) - smEvent InGame = handleGameEvent + -- smEvent InGame = handleGameEvent smDraw Menu = return () - smDraw InGame = drawGame + -- smDraw InGame = drawGame diff --git a/src/Types.hs b/src/Types.hs index 4a65d8e..3c72a58 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -4,7 +4,8 @@ module Types where import Affection import qualified SDL -import NanoVG +import NanoVG hiding (V2(..)) +import Linear data UserData = UserData { ship :: Ship @@ -15,7 +16,7 @@ data UserData = UserData , pixelSize :: Int , state :: State , fade :: MenuFade - , neno :: Context + , nano :: Context } data Ship = Ship From e82c826063836ea0f6f968a33a0ae29e7e6fed50 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 Dec 2017 19:41:13 +0100 Subject: [PATCH 23/35] take only newest affection version --- haskelloids.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskelloids.cabal b/haskelloids.cabal index cc314a1..8586a48 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -65,7 +65,7 @@ executable haskelloids -- Other library packages from which modules are imported. build-depends: base >=4.9 && <4.11 - , affection + , affection <= 0.0.0.7 , sdl2 >= 2.1.3.1 , containers , random From 990f1a7daf5b648b9432df99e8ced2b703a3c935 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 06:49:41 +0100 Subject: [PATCH 24/35] make it work with nanovg --- assets/haskelloid.png | Bin 0 -> 44788 bytes haskelloids.cabal | 4 ++- src/Commons.hs | 6 ++++ src/Init.hs | 27 +++++++++++---- src/Main.hs | 13 ++++++-- src/Menu.hs | 76 ++++++++++++++++++++++++++++++++---------- src/StateMachine.hs | 2 +- src/Types.hs | 44 ++++++++++++++++++++++++ 8 files changed, 143 insertions(+), 29 deletions(-) create mode 100644 assets/haskelloid.png diff --git a/assets/haskelloid.png b/assets/haskelloid.png new file mode 100644 index 0000000000000000000000000000000000000000..f75a4e7d5e45cbb074192a4db23bc4cf0a82e0e2 GIT binary patch literal 44788 zcmZr(30O_(|36I>BgGgBrL2)Cdqg$EP@+uCpwP`aO(>+I(#=xVgpi@dC`~`o#iWS3 zB-y2?kTzS}I)e1ILXVNPm>PqRl<FGJrd9BNaWlnA@M!K$Fb-Z$NACA-Gtfu`m&+9~azE$ws`o)Dc zg{k8P_TGQ@h`~|up?S|bT-A1~o2O@zC*3i4!n~dbMUs5m`n_v<_dTB8cg>xq0n2us ze=_C5UhVp>T`E-jaKloQ5)wXZWX~{m)R~@QY_$!l5z; zZpizYE)`Yh;^LauHg?0xxc3X3oab3N*sFFq?*rRQR7BU-Ml(>4!IQ5M~> z`8UVx(&fu#=9850gz<#o4h{~jo>~D3^o(cWu`#P!mNs^J>#}OqyNbAk)`RrSl6?E7 zJGI^E6;IA**}EJ+emphPzG+@VFY&OZF7wYVdNxz{y3fmvxr_H#RaUmlaj96}*h}2m z`^DS0ZwoDT=|vV@hubzL%$sa+WS-AYb~W5O{K0?sAM{X8#;=-DC0!2gR^91cW2|O= z*z7x862GZ`tyzxSHrds5v`SZgz3)}S@3CI=RM4Mq3{v%bY6K7N=@^WsPt2Q4KhLQ9 z*MG4=zsN5912^#yesvo(-~0MV+^o;v94_3v?y0};{{Ku!`}sIkk6179$P7Q^V_ZI?B@Q{7cEnO%}qvABXhR=r*vY23{?7 zTI4BmjZ0Xk?f5jRMCqWg$V0nTaj{6c)HWXl8mYR@e0p@^@q zACyg{b(CftXd9YtSmIMt@(Vw5xZ7+0Yvb@Hb<1?kK^SC5q9v1$>UVEPw;z@#sMn2r z6_Ny+CXL1a`bXS@bt2b_GqDXh&r?sli|8!%&mSN3YFpXBP$S$tk{{E!(BJpbnd9Kr zeUqR<2p$QVAf=yl^P)?XK1P+ekihe@5SsMMRnbwb^bq4YNiZ#^$E9FiMuX@1%*Iaw z0ef7Mkeov@QikB2yx@p;*}v{0%$JCBMUOGZ_@^#9c@8cWukRd+{}V%udS$Yu@cHxS z=2nH*eJY|$3XjS~XviPM%1zHMu1dwD!Q+BnHQUvE&fn5h;VEa3c-O)Pxfo&rrCXU+ zNVjX>J6>TQ?1LfH}$N{Po*_l@nQ(YBF%}E-2VS&wj;eAcS%yxCq(ZjvWr@l z%BRPKuy;UlAn9J#aj*_|yx*l>9)}4=S*7QWJ^sKf8w7`T)1~isGc|;U6|~-+pYqWt zx{B8&{_^f!8s%|Q4(x8#EHmYXlwUf&_DY$5ZTI^}F*=MO8=-6|8I42wwkcPL2$t!& zkXJ$3=2%Yne+c@E`X4rAE1TY(oMjK6kuY z8c8Lz?56J?Uh>wLZ4s=`qa(ZHXUL_=digMwx*X6ntDUqg7+^hyO%c44(^WF)$jWv` zOpqQ?XTzuepZHjd%G%_o&aNiHx=_j339H3_VGdXPuO-BvF3DK;^&R8#v*E*sYn+Bn z#hpg3yoA!7Iu3VnXU^J`FK=_lLX)Ga4zm>q#Ee{K%@dQPEa=tCxP-#l^qRtt`hFkv zU2T|Sm1d8qkZYv9gG2IUwX`teoYxw3y{mF@EqE6-nP*u_h!$_xrS$|p=D_jEB_ML(3PzZ#>$Iz2 z%^*&CxQN9@_E^EQgC;>B}DQ>DP7+ZFxw0FDjU0r8n(-4zI*P3%|%;{_pwo>sDxI%qJde@e6u2ZkNLKl$4fd z(8*xPBPijvcgX)Ep>DJAYhvBgc|I-`?|3}IkQCq%p5Zc<*?|yoVUss~JjV~E0F9)h zLi3sPhATP*0_7(zy6ROkq71;8;|z}H%LRx``VCuNYz!X`QV^TQ#>Q0{>wG*L)y16! z&5XRGE&#M~i<8`n!{tkm=pBOF!EG|c0a!vle1X_X5UC>XRTrP#BY2AWuhR#XYVfUp z>1oZ7ta#=SCXw#NX@a(2D?Q?{cGHH&P8ft;RRjVuUpGUgPOvxx7zOWf{{ZhpWe}5} zduR{krbA>#tavmaSfh!?67%$j4A=texySmL-1I%#d0ZjjQCQI#S9abIJJE|7J!MLwaR0lflKwJN%n>_S^LOfVob_x+xHm5W$bs|IE`WeuXGv+lF@!n-5}sPc9mP z4v%x52b*pGLQs~Mz6N`hx{379J^{ta^XJcZ3{Tni1+x$s_{r3bw4m!UYdD1gzgHXR@Fl#+~udrK7uB9Tgx4kD^6CsFi1| zHtOj&NrAIGc|ul+G+@NQA_~g{$ZFxNQrGQUi4$k3mG}P-wN~`b+a^rqd0t-9g$oxx z?v@+OkmVu`V%Wjm@y<|$4RRWplAj;g1n3Ii!OgWKcuH4 zIX@mnitW_O!}6XzyL<*>GRXI+A{Mg%(QN)BULj7Rs-1XVFiwKOo@p%coX#XjAxMqv zpzOU0YXQd4HnEkQUHY znEzO{a_i+TE+39k)R%RUWYIdk@EP8H5PzT-(ISzf8OXDcw}N;#Whbn!OH-ErXM$H& zi5!3a4=GFk^7q~JpC!6OH=}3-xKP4&!=WV7Y_K_!2Tm_Yn9EAf2CbCZX-ozzjWG8a7o&s}*FeGwNt^60zl0@KN zz^|sb1kckzgS^AjyDME1@}Fhz^}mM8AgrRf`%&4OaG>DZ1g>^hsRJ3l(T^b5*YD)3 zzTG#Vcps(o3att$?3)$n?>j(#d8g_53m0J7a7DYXa?>;geXakFd77dmtvr1uat2n|Wk?VroFe3HGE$|kY||Pti;Xt14V!^Vs^ox0dfr%KyZ770 zN^kVe(UNP2ZRc$kXel>s7bpx|D>xa$-Tpcl z?rhbG2P-`(B+ALn_4CutP$0gjzgl?@*xbw=8e{~DZ|tZi;LKwvQKecrPYO!n2!q}~ z?jL53C)!WTc)p5$c11Xcy%BHp#0nUc=<~t>F-@bi_{f1)_Pz?|JUrxs=hq9X^3*-4e;4 zBC5nh+(xK)sQ&`Gx@rYzAbCQW%KEMMjvBc}vGh*ka?!g?IqM1e?cluiHUFt-NEY4<0;lToX5iCF;Y+simdO zHc0sqi{Ld@Dt-9()pNuwa2TQPW`4?8m#9Ro+;IE1dT;Ec;?YaN;q#+}j#M_?Lr!;) z5I^3j~@N?xQ8Dk(5GE~_V8BPv9N*<6{{Ho&d zx5BKLJc+lel|z(d;*_~#!s@kaTbh|7NWW_3mF)okWXa*-allGg!_b>j8v=oC>q}v3 z@x)0K(-)8tF&5P_6fA&vfLeL&+s~x_h_d7<<)JsEHuDt*;-~bTTDd#2Y%<5dXS}5c z$4Ih=L+bPpdXZfdX$2(9(UIXqWz)ric$9tp@~KLm1e4svczpVZIU3n`qb1o14r?#J z*+|n`shx2Y`OAgva*anq{KL+@^lNSQBgw4)shx0l?wwZ#g_3CzZ|cN@mx)#lgAr;a z!xRe?Cl8K}?DY?emK@!kdJ*&<1od?X`mEPTtFEGDjK_ls;kA z>bNT5_=#uY@%uZzy<5_ghk%&I+qcNqGBtkVO!aG}$!} z-Kezgg)0>{@FYxWkXGKXsl4n&npP&gBF9MRiQ_UmE1O1>S4DE*LIVD))nPet-c-6n z5{KbFWYxDI7b#B!l#2bs*8gX6+k58?;}eex(%fl`WG;o|?VxP8<)Rovxy2U}N&Qtk zWsEK%_of~tfptHATkWTo(HyLyhvbo?sNN)EtG%G%{|K5vS_y{H41wkz_s%Oekc%HiB`F^` zT9Wn~UMKRh?T;K#ov?T^D z6>?~)euux*-gXpq!)VG>jyF?Fo66sQbqC6OUYYkF^9aO#5uxVaO zOf;vvKR;l?=C(}5!$cupBq-YiktlE~C04x45bl+=<88j!Uq_u322idZhEQH~&UM05 zg7nGLF>YP)3PeZk5nNFpP^kmvKnQM)tE*pRLY=EThqP#izfO=4>JVUm8SnE(j@YYz zRPhLvWv3pVnD{A>hsi{&@EcO~4Q|XPR905*=hOQN7@){Xt=w2&V@hpi4C;pP?g|F9 ze3T?jTQ27yDTR98cz|+zGOX$QDK4>~F^Gvy@JdnOL`axSc3rhIbPtojiQa>i3JKPm zOgN1r754-XmxKx_M!`TyTyL9#?qr65Ccko>_wUw219o>#@JbhcLovmtR$hVmyi@sMY??$z71X+~* z=Iza!-g*5oXAFdJmj^Tr4toM4ik5fRSWN?EVUCmB z$L#t;DhXr|#PTMAftSG?tihwO|LC;g2;IFWmk|vCUdOacZXE$3Cy`s&LFvLa;~=#g zEtyJLzxI&DIwNrDg70V`ff;eAFIJ=9!F9GSH5@gq5CskfjoVCYxM#`DUCG%L7)ZCk zl3K~#3GN}NeI!8RreqrODXmlqn5PKUq*=z2v>%WId_=T9sMz&n*iqTku(#Yw@rKZ% z-bX87Fp;sHxV;>MVL%k%F1~TM>xGi&dvIxSeLuu^6a zGDqOGqXg2o1*aBAF~;kDn@dmH?thhZEQK``DcGr(HT|`|_bNZ1Q9v>CQbbadHoU#B zdnu>jFaBOgd1;Wp&i63kY>uS(LKg-oPKMD!L#=!cC8^qFr}Z8NIt~@I-}MDj|Gy~)2x1cqMf5~%fC^x!4YXvM1hrCX zpHz(Fx{Zs{;CfNv$=^wfC3l~i1f@2gcsKdo;J$tPCYL#cMgYRQ_RFXl6PFNgUHF~x zugPega`*LZPRt6#@{Fe}kxX?GD2)ikT)y&~P)^AVUEf;kxP+&Kga#^Fk?ud#7%P3t zA-D3YqQK4+@G2rt@iKrP_N!ukO}uPyca0tjG~}&Q#;q#FT9BC z>TE%elHL`#XV0!;J$e?tnA1;a8XOpxz>1sYo+-tBQ;J_im$>kdiF{2lO%Wy}t1nA* zCqnVY9DmUAhjvC{R9pVE*F&j#4NrzsN=scw{~L<@DD;@9%^ zjI6#q{FRBBAqkRna&LCs?5cxe9PxJMfPP*I1x4N{-ruKLE>*}9^7u})R*nBvX1{sL zZ*UT+rrgTO$#MNRr{64=j@8bnIk0bESM!*j7tWtQ50BK87MEZYjk@apoV1o)q`ppA zM;OI?pQMiALe?d6%&Lc9YfOS%q=0ol6qH`tyqsd>o2 ziJ^wFsl*7qq^YCS(v%gE=v8|{hT`Ur{=M=Njr_jcGcUjx2LXndAxTs;Bzf?D5(-Rd zmVbDAH>Kh4zv2(amGAM_F(DBal5@P#ly?1M+(nzpjqTE9`N6oEa`o*(S?R{EWy<0= zs4jSTXlKBcAVT&Wx#ViYL0jMVa~-X8Z+!K6Jy3U3!R!eyYcJJ8e9kTf4L*)9^7FsOmrV_g0AM{F-`W`8x-aLs zbrwn-dA>-d#m`1VF6@!(>bPsBz8O#VzJe=ubD-LG(R(!~X}(~RDS^G(jQ+#4>H<^3OqPiflWq_q-UK&$V7?i%;Q+Hvt0%s#>;u35z1 zGSTb0`nNa8T3sL;pnRw)C@=5TBoBsY=H~(Z7K9>GaxpGpJ~jJD{JhcUhm1r#1!*>r2Mv;cC?C`*-f-%7c8RB(9^UBM&uYvmv&qd%>b<8#JaTmV?epKs z;f{rlT+wtGvRImve$NQ9uTZV+Y^i+@>{NYA_6S-%x={JAa3Uf5GcgM^XhqoB^Lk+cJE8Vb4*C#M#V_-InJvafw_9OK= z*!F}S-ohELRq?>=STRNRK31^UdwkmD%&t5QI|G*xk(kWfy3@rYQeT)MTY22)=Et7g zUSx0iA#GGVBKzWo#a>3J?5QY!Cv;4xZGry#lnsU=;8JH0O zCyo&ck|sg7YD=e(LI9>JvRk|k?%^c{BVflaq`WJCb}_Y&Z-=za?_*JotR%)4NBh0~6^EBTy)%bg(8+Km;{o%S2so0uS z$T(0R3Tk$w9ygxapW(^D1;g+x&|(Z&U|^<8R86!>e+MJMaTBd>DtDpy@EaWxFQV}d zD2xXQ!lXHlOz93ho4I5E*|TST9BaF)QDR&s(ZPGBO_oUhACbF#9ZGosl#_|vqPT>I z;XWVlRP8m}?xYh{(rQZrFTF$K<4rU^64QRd`1xzFgX4=O{`EnxXKFv%5#Tl&w*Q91 z;>EsKb2bly-B%EQ##c!mEn-RB=c7~}M9;u>_>R;?GcTJ9H!}h5bsXgJBJw~vOV2nq zzjvj|6qJtV^U^~*RkOf7(#>|lF>2Fw^(ab&L95!y>eA5?WoK{;sWtvW;^NEe-^?e$ zCq7F;A&2hmNfZl#d1iOlXc|@7wSzRvEhyPuT(JJrg9)i)1cAYOVqd;|>51vV^Jzg- zsY>k?mk=0T@(Btc%#h;@d+qYl8^NnjJ7w*)4I|sr$Z~U%OWA&oLkOqrOzb(d`w``n ziJ^emE;QpzbBs6T{~53GZAa7Kf}adp;$cp;MhT(^;bNkqgCWbvzhBC!Bnfx2chNnt z`;koCX!PiiJ+KuVmpi1p#@+zA$dkchWB7jDs-xB3?mS|xx|5cRRHsww8E()%dEkW^VepYRlVI52xwga5HPTu2E?;V#KwCkdLi@yDDj&Pjp2gjAYhj{PAWF zmx_yQttuX(`~nB!|Gzl}a!rr=Gp=eVQM()BlD+5-wg6B#LASlEE7@bzV$W*=oR$dF zB)2Z;T+N?xA9&BjSxihRrjRobMT5uux}*W!W%g~#L7jw zc%Z|dao4_}7MA*>uPPZD5;5lRZUSd$Q#5@;!E3@aaokd^Jf(9GDH;8}5^_G5xi_AA z>`6YD<3i1qO{K$W?1Q|dEgBI$ix*%{`~|9Wl|pFL2HW|c`$sXOJ_<@>Yhb3&hSSAx zpB07!Rd}netKuR4KvR_Y1%61p1ar?PG70vz1Okf<5?hi(J|2Vb;q=B}$TMWx;lQ(z z?>&0Y{A*B0y?}W>OR5ZsZf>ZcaPcMooA-4I;P=2G@DB4+8=vY^$)D^D=E)VgBZyOX zLMz6ngx{e%g5wbM3vOXQRuqiJA;Kw6Q6(D$@?w(($DQ~NQ|OOXwb>AvIYPNuS=+z; z&ix zgT(j*D#9EXIa6>JX>hdK1i{YcJU{N(^gOpf2U210=-B#!_-$oi7Vmk)uEmpLElDXT zltGvyKBv(sw!ueW9q63$y9;H6#XT^u6AEl#PS$-=a~QKn`cOs_GOMte6F~?74qi)b zkl%MBKVKuK8DtkU+v~3*q6{+`w<`ucTm4Q!3CSp(&MvEZVjr=aB8FZlxrnGu6o_iW zB+K+vW&+Mcha8*dV-}a-$Xv18a>$PVeVDEsd&Y4Ye>~w-sXvZ$n~Xb@X2)b3kz3|b z6m_)lJ_98eB^3(5teKR`Va#JF2fM(FFJ0&i-)9tJXAeQ*B%MID7)mw^x=lXmk4a%$ z&gC>R(G+#Z05*c3KcS8useK6CZVJd(OdL8v%^^@ajreotS}baH)Lcd%n@nzMCi6z< zv_jQOI_xi-7{{T}tKo2rm)?VbHY^8+hy{$6S0~|~vgA}OZrYW_0&0+9v3*#b%`wP< z%s}zzlH<@Rt;)&}v@E&sa$J%bhWm=aWX@lvq;BY05L1)!P8b#vtt5x~y1IV5%(gn= zc}|*uSG`q$v^DlF@JL@~#biG^Y!}WLx*38JYEFWZ7=g5Ic=wtCb^(Rn_br zQ0LMc@s>=K1=GZFUc;14EvWn;Ot?)sTOcKR51XSyQum_A3iOp3Bc`3`YqAL4Ht*|V z1@|C$R8H&%^9;iww|{X72?*|%$?PBWx0X1J22O@n|8!Yn&@+N1mrsFyogg-pS0o!E zz;;fW2Qt7$%g5w(f-^={R=h=^>mNw?#k<6%Y9n>HQ&4{CPw|auO;$irKomLprZV2+FvqmQjd)Y%4%gHe$b`3qctiZbiBX3d)BEiM&v3Ft_z zAXdF7m=ydhiSx#6c#(W6IoWyVGF4@7X6z*~qB>ZW6u!xM0V zs5^A$pn$70(Mwh+@Xv}&ljILPeFsl}>!H~NvVLtMBZ#fU5>HsYq*OM!`~z!Kzq~zO zB}m%#GjR#}=FMfcspA{FQFzEn{|4U%B_JnDU>5z*XrUt4Q@r-s%a_f65UM2kNytg; zN!o^1998u&Yn&*+p9^3~iR%3Iai1?9y7PJ*Vp45V(X;U7W5R5xqmvUC(E14G)StHh zFhwCpLhH*kg%Yhtfx)z?sYz2oy<|qoq6*6yC_$rJ24;1VCmNI7?6O*onZst{9thl>8q_NQaeF9oTC-W-IS?s4*3mE_8 z;lqbho#S3=l7>9B|8Pn0(6ul>#-lMc_zaE3*hv;Kqwu-}*_+b}R-0pY{fu&u-=djc zmNQU)H8r)hcWlEVx!`cz6sXGHCm%n4Y*u&}+IonPQzRO4#Rtfi!HH!fee-WZU4%kF z#Fdh&z=<$}KF?(hwh1q0A|Oawq$&-dkV}BVM3DsVghSAp2xf-IH=3Xgfv3b0T!JaEk~Nd>adVf=m@%Q5ael3%o^RhqSApdVj1~ z@y2!Lu&N*hfK>D^1TKjzB&~1ku~|sK$V8W87rlNX7329LU=ogtL0^mXq}&S-I%6@$ ziC&;iAkkaFhG8RR&FALk=0ujGQz1HJ0!+6iqUHH~(lRqiSYfs!5^gx>%Mz8(_8ZBK4mp(*}7}V0uXhPJaIUIX=X$pa-l} z)l*e0RV2tES0sTdocIeUGTrX3K3SIYZ|v@(=V1dBr41}-2SA=TPcee@*ZCgHn!z4jgp4z`?X=#~>@hOW9f^Pu=!5JKg*^D)b`GSh% z+P~ObvP=IV+17BsmM@;n8J#0VWG&`GHYtC^s)r{w4HE3P^fRO{w69z&1s}?B=Kv<9 zi%1f@mkoRKQt(M_Ygi9Ly@mWnc0qBKGMH^hehHE$(tJULWM~BcL}ng@?++FTeyf|z zSft=p7M(B$nFdrIxwz_4TR2?g0D5g#a6wmdow&qk+pxlX= zfhMmxZGjV^F@17*qJL>v5);pJmgzCH1YttrbxSHJ~G=W^#ZF)sX_A_ zE6!gKA~n(=GKHjN#_IGk1y>~F{%atdNEf_<;sS-3ko!V(p~Sg>Gi4(MBeN^sL19zn zzUUvVYL+X!B^dc6b}e%U3M8`ZX=b*qdGkKIyMK}cvP6rQ^u{+7g-%mmjC;KdCPmRD z2ndGzg7q#SLda&B-!Tw_ zRF#*1&9%F$F^$YrRm6jp8Z%%|kj|JnY{hVj)x14iU8^Een=4%XMgli}x|DdW!t_!2 zl;kBYpQrTVMAyG;Qy1?TcWl;LjKbK z;A2QFW<}9Z6T_=y@pAssu;tc0JZxt+TvinU+$}}2NBkqsB{{81$^9r@=t3DhG*l6( zr4%s1vKWQ28N=SB(~{vRP9kKg0wyJchm>}AsEac)JVpsQX5EG0Dj_vB)gD4JfH-WS zk10fvB^4kM&Kz|CFe;~(Tzx6+zqXm05cJ=PFinqo;ss6NN8)HC z!5@*&V%;jCNNsYb+@Q&yguse9IwYcz$|FaIoQn^6xgDTZ7-3yB;Mr&zE%CX4)lJ)+ zhAsbQ{b-NtUSL}BV?jG;{3LYQ(9@WvmZF(q%c7L4F{RezNjs!0Hy~9al2t-@$BTv9 zppiuUs{$-!+j~qFV?EPlB*S*K)&Y&`td7Q-b8L{X5kLOx!AeJi=!WVJ-QMMAWo5xb zewv6=G?*K!&A}!lKR{wW-WEN9#WG*Ob6ejX8~9eC{dMV6`$YW2iO_S-u_QYf5CSBEx8vrM^S>dtULYurKv0(6 zQy7wI?Fo9(Iay|xX9Dum%P}dpt`y-}TU%36No*b($wNrmFFk^KyQfD_4aFR7+%TNGYojULfH-ld+Rm{Z;5^|DZDfyUo z3iMh!N~~-KoqC;s7ASRq94Kb~fd=VJgEXDYdCschxEoFb z*IZ~-bnWJu1Z*YYYqo4Gw2pHuE8cFb`9Nh-iU)7B#eiK7 zZW~&Dd`@d|+<>qV(fOLb9b!sOmMU|%%7KpJ$-9Xyu>!5U>u2sn?4%cYSPvtg7VBjU zr*{`{fa8{t3Mrx4*!gk@6-8aBmUhPeLp-cCX1C1=S@**wx_R8@>P9$>$-PLWr;*f% zmv|NL2%I_0yc-$xW-FJ9Q$Ubsv8%EWu4xdO08%O*q84@N@eFizP-LsNeDtxau{oQm z_B`;C!_3Re#vi|?g`&E>z5R28=-b_uYu_Myfn+ASz&YjM0BBrbRPm<+_zRotDMZ|2 zCCfCh@z8+&;SYc6)AAUWHEAS0G#vdNI8!BkkCUSf(O6 zgt2;Qa&(Akbn&N!AizjWU=JyT7zZD4ZXNK?#lZo#rFvakU%~miF;5yr>>3Elbkgq{ z5sU><$jU__0o`@_Y>8Y_;;t*WT-9YF41 z>o2D50vV3tc#`OZx9`3WX4&^Lc$lK!h~$U(WsW5Ywj}YJpw|_lxHBTMVkIgLbK-gQ zB4xa&m?yIqRG;I}_N*-3s4&F8YzU%bE)B6m;IUR*ZdFy4Ig_vxz%j6*m{b0k=#Uvy z&Bw5>a_p1Yi+%w*6(5CM2xQ=3n2~~{kUeR)oXtfjcyU}8MEbDb@|)+o#JwDa5~Kk& zs+g!lHnimw<#My^n`YCzsd&ZFX!`tWiYBp_kWLMaE(chgi7|H$Vtn9e>oszv6tQhq zb#Cxx87ZDNCTeUn*i`Yahak#Zd12FLRfsO2r1T$1mq1_fDKbhTG;%6wjerEXWmR{^ zRX1(ovmwQ`ry$}ovXiC5M7J^@E?=NNQb?E#=x#iTxZ$yTtPlM~4JMt>L~4};8kB_!(I(t6+fYgO<~RljWB)siD~l-7ugpa$r7X=I>B{k4-jMu!2=~$Y40#8 z3v`NNeE>mvgXMJXhQuu=cB26V0fGAD*hd&*!X3zU=s`KeL=YMV_0->8;vk`_+$q|f zV}WhETr8c4nFR5kc93a^_#u1=*9{3#i#|v%)a5*X$*}uFU?iQa>dUw@b0E#-Z^D=) z;y^to0hi48!`y<`nXGHGK^DYP#Z(8UGGy9ZeCNyz!1aZiWOKR3&ISYc1! zE}S+qyPwvNR}7M{fDQ)(9$A6@9Y4p-`>I1dSjkl>O%Xn?`W7~%+n>o;%2{asS*ygk zX`}OWKRQxa;WT_$bbjUM%_ETjPOPk`Xm+mItRwFDn@e*UFpDmwVL-23>tR)JR$Szd zyS%twWa0z?xeebOSC5jn0gM)HY2ge*DQrU%2#6+|(V!)%iHY?e$P*!+d64sbadb#C zf)bAI4?#nZ#!CSDcp;OTXg3cL0NkR`4@os{XuV zIe8|ly0AA$qXuMyt{+bC1YKozOk-x+yMd52WGks8!A*ezO1cs4r_7!C#fw@>K(p6E z4&iTTO{szcXeq}wkYyAbLmICPkt;be`Yh|kyg6MU2iM=(i<|!T9VO}~35g!^%9#o_ z!+1JXnorP>BsQ5O_A(8%^iAY5_slUbe*Wy)CMLp-b_W7%XJD2{khA1B?LOjOE?l^9 z(}rPhj?3>VvQlZ{WWW+sKV09^Esu?-<~WfSC&T@ehK)S53`a`(}_ zEnX}43fvO3G!Q|Ho)BTS3RWDIa~Fta_4fizKS6;by9nmwc|k!+LQbP4@C1~GCsH;n z82ovg*c3grN{^uu&xt-*2}B$j7v5y!%m|;K=SP>+1M+Ymv4UR3U9b0q-fMAU%Ln*e)AAhI!>iO-#1`92n*VP zab)tK6~uRENeMjO-zU((-ese!tLyJrxX4(jWKSi}povx1L=|r!3P*>Kk>^ld3h zxe<*|KK#umR#|D%6orN6Ceb~& z7kj?kc!+LP<(;Z{NA(p=N1qyibJi$Ejo-MoL=}0>XvPggC8+EuOs@r4`&0x1qQhdOK@mD^4;;xbb z9SC3~fY*^DM$E<(I72koGJEI>DgeDlDG*p57dVA>!aNa!7o z2z#)yb-Z8|eaOyCMQ??-^{_WO<=f%yuWcN;+;*)FY7Sn34m3Ik}DE?vr@l`Q8gZrol5b%C=AT0Sxm4=Gc~;8uIZdA^J~r+h6Kg)waE0Ff0Xn z552b5*}06lG~}`@QYAvV}Fz>?NWeZE_p-2C*~>BurY6Yd|AWnlj}|m>Ic6%9)5?1Z>NB z!PpT?MI9h*sErn*TZXsAZe8O|v563nk=0^YS~`XF@CeT=>F0lQTEgJ65Hx2{XiE)! z92O72(>WpMJu+o0$@nCx;|;7)K@WQyrMK~N_n#njQ0vb*&-YWuulsDiHS0DN0MqCl z2ZeVa1Iv=)o8W+^m+N))p))by=dRZu<62_euYPrvBX56fI`^rmYQ&k4X|i5` z!afiFC=YpKV0yUh&dT9K?tJIq;C3MJe-{0Ey~r0yHIJ{bx^Q9e*zA`V#@0O-E8Vg9 zBnj^L;zl2rCmIL4-+6oI^1`$W6GCGKi4M)H`0WQZtJMZ~eqZxH?#|60Hfw!0*Zg+`#axhDvhLybTrLuc&!0{2ir zr{gQQ_fX>d1g(HAe}ZC3ov}}~_SS@ynv*C6a4TTSR!-+Nxg)BP*K9#qlfgKIs^6A| zVsjkcAttNx30Nn1a9797W!N?ye<^3ncwi-CUw$jCg$}Chy-9Ws1sIXiE*Oh*U?^pv ziVaXWrJgg<0U>8;pDy-`#iR#WrD>9nG4#i#R$H?#uQ#L_=f5CX!8U5{Q%${tOY8K; zPU7CO;d=2WdWsrxc?{rJH~p@T1pX!1Vm?mibV+L>DHa;sm39k37hCD~w8=Phcj^-w z`XHYDjF&GLUVavcfOfD@8X8?Kw9_MoT;Zrve@$6gfsM?Ok;72Mo<&%d}%Awv)ZPwXQZopNqt~ z4C3!_K3MC^b=tagNXN2Ai8)cld+6THw1abxQA)!c1YhE{(3K%Jm;=rp*pEo4kvkiD z?b@}bXe{I*zaNwHg#n*MkPON^JJ7iyf{wRy>yqM$76x;CCxVvAd|3~gmcU2jadf5{ z?dN25&{^bK!|^0Rbv9V*6PP^brVID+V>BQL)cmNz@ ziZPd_uH%_sBVtnrm4>WDTTjyx>*&DfOJ%f-*HbPJsT%$dH+M>XVLgI7sg)AT`AVaD@HC#a`S@? zVD5*=FB-Skgli_h2l6`;X>fA#EF^=(>Vm}HLw>1Lfe&0ffAR#jK*9hJ;zA;kS%xIU z9c;|Ydna<6Feg}iyO>tPJJ6?2ZiVXx6vKa$mUCx> zNweN`D`C>;nD>h$hMa|vkP&nnJzZBkSny1L5clH}m_rh+g=Gv!iXb&CWm`It1)@b>0y#$RSn=CeiBGop$+E3eP>7X^~k5HIi z$ijYbfQ|e+93()z%|)7m`C(JM>jt9g$gM@`SE7e%k*kS`iPwcqYdX@I-Tej5UV&DS z>gD$t*iE_>9<=o{G;+)k-T_+R=xt_wj??TFh4^LiC3M>vMei3;8KUSj^u&h1tzezR zmDfH;A6>F}kigvdM_L`+W-9P+);6Ah)z2Y^F$z9cii5wIrKX;A6Qm}@BPS2->bM`~ zK;hDl-?2+ckEWnQ*X-tSAPi3QmoVA+m@LcC3zm;N#P2`nuHu}SqEIjsVLNm1(%08E zYG=Hx?QTd|_3FWOo!I3PK_UNf!qK7D?CcND523T0n!*Y~$euVEwD`@22XclKItW;u z*`d1!1iKGkSE3X;Wngz{T$3uyrk)k=V8t}s=PzC~VS5($7AXO@F2MLH2?=#6#DKc| z>({Se%c@R*L*PP$`EP(JN$Si<(f~1N-9i?-Bz@2Pzd#*}6}-wDd)^u#K290|C(mT^ zl?k1hg7ZZ9gK)UF=zy-C1TvJg_-JP&M;E)0FAmk=Eko#V_#qcqw9*?>(Lw4LDqs)! z^;6xYF2eYP#zf)5O0MNR&mgHZfH173Qb^@OLCRLb-Os{IdC4d@R;xN3 z5KkeBI9n^D=2!kmpns4hz8^%d=!df^n+vmNNEYBU{VG>Xmpg%)ArW}qvPIv$1=ENq zk<{v#kh8^r)|V|H$ivvhxlk}@#9Z+&JkA#zU?D7ZTbGI!+mjqwqXNJ>%5$h-gn1sf5)d~+1ZEJ_!o;eXf=yh359U`#R_+Dj)H z7Mb9p6)wu$D!!EAn0-j&8tCh1PA5 zq~O}iF%erD50wpEaMmUFobO_23a1BJ5#~RQ1EoSJdjVidUo&{VCh=w69s*PJ;iy~y zROviWZ8W4o<|HG>2yf|$x2P$sx%2>UL1&@kU?`>j1?0|c7Fc-=X7G?cW`vg!n&QIv z^_-2aYuTHk`|4P=nYJO$(~`kn+2o78b;Gy~F^XgV==M!v&ugLXy}j*qyXcM;BV zL{~>jMR0RRtEK5jGbcuU-y$e2n>KAMv!G>*CJ90=yGn+2(yX-B<$Se_XId$0W1)i- zRu&5W6E{my<_guu1tFT@LeX+S;HB*X@n1c=+8l>qAdH{N6PflE4Osy!{sQy)8*kja zuult}3XDeK04J|`Jlx-mfM>|7bIFyPm$?uXfQ1QGbGtX8d6&NPQ491t>lU=mk&a4P zCWzo1f$Fs|BC{y5Eb}q*1ggUmM0!I|fZrH)n_F(A88B_0;TG^orLf;@ zAXGCDuDRHbrlSLwPNvCz-_)|Y~(%Q4P9n{s;>$0Hgm~j+DXDz*= zxe{B=e44y9rf$wB2gYxiK1g#+8sCkZdqddo1 z&AK=twFS>?5QuvQti6I{CWHIH;??!U;+9gJ24?>8srl;Ft9`B{)D?EDQVLB@)YjH6 z7x2jf6zwzjk&602E-m30OP?pWIN~D#wsZ)`d7QDk&%5eceXHrmPxaK06;)M$2^I*z z;0#Srg6?p@yEr*Kl1=on?pkaYt||7spxkYA&?`YDM9)Azic~duyS~%=mp(23AbIp? zEM6cSguh@s4uXJ=3X!TszDsoRe!xW>(PV@c8u1FmF_a?^ER%b2fOEqsXaLTCBU~n0 zhBvpd8(}0uH7*E)=oG)+ zrp|p@XsZ%3u%x;RP-u|Y2`j>BiSatx+LH_HO(W1;c*`avz#L7&!e>0VUZ`iErPbkE zPUeOT16t(AW>wF?3vp-=p+qSPpZ{|wN+X!MV$3Br~%q-q2J|sI7`m~Euj~W6C&EJ+IFj; z(%llz@?+uzI7)RjX9EwxXd2H3ZDJLvjP=tRaK==wJI=qXK%z|A84HQVLWDR*uX6u6 z$JCaAXBq+PWbAaa!${6J**0iDEQC08ownZ$7Q%~@NP?THQd@@)Z@GpCXbO0P+YfkP z7~1Po)@Z5po+>`EN<&?p&%Ko1034Uif+)ET25JYvI>dc}5nd&`S_k^7?n%Jc3x2}8 z{yBV_2__vmLxTAVg4u7{U*{2qpc7MLB_<@HZ6G?ljd3 zC=N$rI^G!HZ=*&_D;}Aw-4Qd(e@7Bd6MK=HlVkSc>NzfIa#NPIk?+NrTo)YJwj>#? zQm&ge>*&2dgkw(UXU)jJ4fmHE=+rO+hH_=OE%9JNWom1SU%1)!bQ}h8_wu`N?@C>q zA^#TperwBSHFBaxV1siL@UgOrajzz^d;@To?&`SSxk~G=KoD`>@aJQohAphw6!@W) z@9}|0&lnA-b?S3#{O}SEMP6P*MQ!&9^r?W1S0d)OjhsqbfaLLaF9DQ+V~V05-@0uE4nF=`ie)z^V|uTT@>PBGE#KF zl=v9ZKKkE48cMz4m8a%f@>)p!4P@klu*AqN=7YLAK7ubPXj9mYd$!zgfu_GY$_P zCxc0&qRIB_9C9lLhk5fw-4)+MKPGI%5k~td9ME!Z`0L!_>zm zM%30r@TbxeusL^QSypsnV$OKNTBt42j5qzpFV?-dJHWs{sDoT35fL&y-R4i~>PKC? z)G+!Z+~X2JJ(e7$sbAz7z!v)p#;1ajpn`g?BY889O#>QSM_i<~rZzHNHzm>E@O1>$B9-}p+=~xE=V3c(?*$jCr))}{ z6KI&)O13t|y}9voVAhOUawx=+A&8AHf$V+i9E@ebzUiPOxExpiq zgUu~?43Hh^5VV$QSf}LzCBaqusqr?Mqu2mp3o@i>W4|JlSYU|11C;jgs!7*uJBHr4 zd$|3MV|1#aV29MdwL=a-%oT6THj1NWAX9E0Y_@baK9yB4MJ>&oKBcnE7Ae`U`>jKLLj4;MlLjsP**PrZsD3zfq%&rGdS{@Z0zVLL!2VbI}MV znH0t)M6g7BR&^KZG9^_A!$F|;>F`#3mU$mbK$If^@h0bas9<7}D=xk0=NcDgiyaNi zBJz0~Gq+xUEHCUM~J7iA|#FLbu6U;U^&&5IjAdaQm{dIOLYMXY( znXKwFAayX2+ZRXQl5)3UDr=)_wOKQ=X54>@pfnXl4a$A9?Fm%pkr^li8>;x0Y`Q9c z>g!|#$1NXvE`WP{pT&!RXnr2OvT;jVPRUphIGfdClr78(@qqb%Q<+Lp;;^u#&n z+pksM=%TwOt{I0y|dWeHH4ZjTy-;Q?8xkR zpKeZ{?{1l+;&a_30yhK^5Ou_2 zm}6-ZbWOL=-L3R#*0+Bmft~;C*_UMeBNAWlnMGh$2pAW8P3yCz5deTx=k02(fHUB? z1c#G^QXXH3czG+Pi{loTl4gU*(jTA|Kl2Jhkeyj`=nWmMbOc??J?QI=>KI`tFA-!R zh@(VY!$6Rrh=>b|Fqa(bbRKSifo<#QjP)o9%)ya+Tc+{>Q-o41VR)1Pa8i*wX$zn< zEAu#MVK#tbt4Mumk4!J@>C_=0iFC9xj@X7CrtWrUo7)!+$Z@AOQ+Udx=qUOj& z4Gakz%}o15n~m4GZYhgC+Rqy1ZY~aY4id)t7YDJT3i#EFWXu%#ITUu6zyUE9(f*Gx z*r_%goK=05w&)XksMIitT$oVH0x5Qk_H&f=0&Jpk2c6sLhRRi`^wT5r*7Jm2fToB9 zh%_hgksW%$urvv}Kt0h(h3vE}dEs8%Bda=}{}|U~P8(%SvKdT5FhIU$JizWUeDp&F ztR@>~qM~ftfjl-+76|4GZTO+I>1ba1YU1U@M9=v^l%Y8DNU?CKLl}2fpYUbi1nCap zmLzUp~soYlJ@$k9cMgFQS%MtJp zR3KKyqdGJkX0nZPDPC|dP@A8+(m^P+gM}(g@xV@WTU)RV6H$Nl-IS_LLwq}Jgn}(6 z1#^KX+}&O-dJ+3zM@dDi|HQ%fN{~kx0MqaKD2tTyAC0#Uz}u4w^HE(Q z!$2eI;KaR`Bf35^xYkgzhvAM1{aGBg&HNJQ!>3~}( zU4@fG{1!m7XZ8u#f(Rs;B3SeQ5Vt^Y)R7_tK22UwYpNbih${X-hgk%m4~9i%&R*n6 zOK>o)hBO}*>N;RdAq#YG{Essyl@m$1o<;(VIuc&UP~`Z zOv9&~jtSrVUKQWB_GBqX%_;=Ex==IWW6}M@3qi^6u-+{AmI4rc+?`lhX#@J(n@fg*&sI7pfm^*C~t6Yqax>Z?0#m@jh z%)NsCDO1XV@%a*1xK-a{1biIP3mbF96YbVw^{HdVJVGa^RA-(h22`LiYjNc17qy%0-dG^VqXmtZI1>5u*G zU3vLk8NP%~3CdL<Hp>4Fa*y_- zzYsE|qB5r| z<(dcl(3cg`>dou&mO0K6wACtY3{DVWwmbx%C!t&9ur&M`C`;58eZ*HIs1sNQ7=i;< z)se7~l!Gl-74v?F0s_e?l6#m1ZCyfnls5F`WkNz%xfuPiRah#gPhU6Tg`BWCY-+zC zu(b4sJ`FuU+4SG|=wfp!!yV-1d}ougvscn6fu%!Wt14Wa8~g@CHqlI+`!6cNR2%tK zH4ee9myT>ALH=RS$Y7w&idcXD`gP)TP8w1zt;-ral|GwNpZ}>AACV#|5^1eQNybnw z2BG3o)HTiX?3);vLv=j=Z=6N#hf~(cluME7K1P8xi388z4W2 zxMpgB8RPM;BC&8}PYsJie4vlIlQFZ|D8Clw*?;m)rS24o2&d0nW3UK-N*%hjd4*`z zc)6&<8U?09aOk7~Zt-Zz7{p$(G6Y{i2LE| zR#nDb{pd^VLW3M^a=#<6hHSeeKDl7y+&}LsXhQmDvj|+O`Szb}` z5}1#($9J-**Fg|!xE;x6kP~Ux7MeD;Im|tX%R(yzD9%260{x|Lv(6*70`Ks-fyvup zK*(j&R~_Eq({)?Cu_j9H^M0fsX$t+Z#5?bT*kP#MDOzRF%SM=bw-ut8K9DD&_oO7M z_$2CXlt$(7ZRufCp-z>LZmqi-W0iK4!UbeLn-PeRiPQr@Iuk*#1SvA1t%uvJV4w|V zck|_@riw)KQ9-93ZC6@=bL(ga9QDui1$*H=Sp}J1xB+#PR{j4g>)PXTzT5vdd1{`; zJ!^>MFw|pg-4vlDGmN5*O=&;e4y&lAn5Ial%^|0fL&8IO<}fP7G%eIUIs9g*he@mx zQdudK`z}e(`~5xC&9m3*{$sx1zTfZXx~|W4y|2UPy11t>rR*^-)&aX|&q89MkQIEK z^#owK>Q6X{Oa>GEXpi+Q+)d|*J_8Q(NALvLz?NU_@|@})JQ{#f09l{lWWL)zS+bDV zj^#iFJS>5>p2&XIZ`$jyMk3sk@rihir?_WfzUDw&D{p75IriZ@V2pMuzVIMss2>pD zo7J|X)Z8beUWmsw^dYf0$emCNE62ah3&Q%_9OQyWqG!|A14k=zsb`! z1`j^0JoqinJ$&uKP~&d_YihdUsT|Jc2${v#144*d$NaUiQ*(3AV#zeVOTA21WPJl* z&v3)?Qd>F0($}f}s@ADue;QGs9}6AdJO&y+Y&d|9Psuq|Wl&ccpCaHQem_S$U^cC%Nnr5OFGN2h> zy!2g8N*e>;cE9Y~W)9+9&$eQgXhi8p!PZar?|oVCfTi#ZFsiezUoqHpYhz1-OT%)u zJ9kLHNn}xQ12Cs_DsC}woiyx=L)i*Jb@41N1;#!JDTbVnApFphL&=#UN4;K8@amFi zR+DlS8t@Dg%_wmjk3_T2y7?0DFzwC|DQj*~qq-C!tyv3@JilJRdjW^XLsvu$kz~l& zl?}zX={xrh4fR~3#lpDo@`V^;5QfBjd`>SlH}2`$#cy${#}kCX)%yA-jGjW z_lC@Cy5f$RPk+e@tE?L)MzVsFA0Y{scB;H%p8(0l8zeTNAvL!^k7uZ0;C3v)pW@&m zGlz`Z`5+82nd`aHBOs?mhwO;d)bt!G*u{HMUglDeR)=`U2gq1u{PYvY8mh$HFtXg= zyW#*#-ttEiB3H_34~!AKZ?HI+gM;#>(rA2mFsxmLnG$%AX6oe_ek=0|6*LsPq#;m` zRFihld`xM<4p5+A%1u`>3Xp48L1|_0R54-*J*zeASvWca2q+j9Xg`sM&L=e^bg%vD!M3isi5x=YapQ?g z9chVQ1;*$eeO+m~!A^@$LSAZgH*p z`N`|cuwD#R<$+p$j0O>-Lf+@K*Eis`vhd(BDz{=0;@@x#2Ku)}=Ky4fDhu05R&_oP z>z+w90#Un+IO7t`w&vMexf0_-*gZ@a7#HW*B5z!w4 z&-FO@z83I+2;)7>xQ>_k%`;yWWo2a>3hv%P3eZkhuP+WRZQX%(v!BaU`wKIjUAaU6 zwItX>wqZ#pSMVDoOYnR6{CF-gYz68@d$5jz>drpqfx@yMX@UUBl91VOcpcD25eAY! zIDJu{^*S-Vk+q60{xDx-&;Zfs49^W0|zVkgP%c9En`V-Y-HVolEnwFa3 z4$8S<67&yv|H=0EhYUK3{7W!6#fxcD6q^uGJlbh12XlE0L#*>2yR{ATmYIMQlmlxh zVGr{I5&uS=^`cWymO>9&jc!QM&BR^Wg%G0(=y?_J67pZI4q`~U2b-CoGE7)?8Yy9S?A76-Ud2lg`vVQ+ z!!^(XMltg(*5#l?*l1e`TweHNDJg>>wq8rV2im zI+1V*YofxkU#HqA_A7&)j_jmP&y(VZO1wm1b2G7@+4Y`IvhBvWOh z1Yw?3T}>mWQ4&C77HDj1APvDHdv^uqw5%9?aRDfu^@RDvWQCB^EebbDYMp0j`qk>u z>8p7r1VJ2w!_8`LqWibRAwL|TZmN(ejFITlVvLMKl`I3QW)cyD+hA~u$St*T=rFug zQFmBY5JU3RB3HF@rNE04+!Cy0O^rMd^B;<$2B2weT~T{z@{Q!|2aPMI?(b>o`nkzx z_dj1TWyLQ`@0>I`**SfR+eh2_uQ-6@cNLXo2ED9&nkws9h z?ePr3@bS;>(qqX`e!NVlF*3?X_cqbRjsEtpKYV!h7KdMy8(v^vpzceRKFLJab$4E6 z&RoBiVgLXfl#&SK#KJn2@&+t`2v>PScIdP6-(ru%3YrX=J_Q%F&hN_fAqIvis8YVY z7rvbdLW6IwBJY5md6vhLg+t&A4m}eEMKU`W-F(!mx(A*;>$0|l{|H^E@Yana&sUpq z*0-mXacFM$O&1-pZtNIGda51yjM+oG+hPh?#M9H=Fnkp6u_&~BUZT&|AMr~Sg~vds zta)a_lJWuosF`S1vxU3!SVs6iVT(5*kI&Wz{D{TS>u(`%`55WHdJt=&k0y}XvgmD_ z>HjL6-dALsJzPi4d3^ewCmzfaH6aIzUPys&aENB&Oz6nHj{&oL?~6Le%}U{tiC1$k3Tj=PC2ACoj?jl5?|C zpZnpfQQ!!ciAKXHWQ2+h-slmdS(n2b94d?F5+FuPKQ+;*@d4N}!IA{_iTqQB0HX#P zhcbQxOs)tPd(zM?;}8Q=Ns7fk!&GI2#EeF<`p+8Xx%bwnu`CHdu*510Ra9a>fNj~F z*@n73LCvO^+#IHhG^)`npOshA)4$TG2PUMo56IPK&*z41)Z*N9>yWUH z$r8F!X-~)os%TwQSgu4g3K(>VN_$1df|#(-Y$7kyclSDs(7+A+tPd0(bvLWA#6LnT z8@qgX^GP7{W_)1^;~d1`A6gVT$Y(9(IINIzZFslVM3|<-aK@PRvNX_L@NR^H#k)5~ zB;gwd;x%VCM}=MEjJqtaYL-xK*uJh#P67&kuzj?DNEPWuoI%Z2(~K*OQ(L=9iUeR+ z@MjXRV0br94@~NY`y?3@p8>2c?1kCMU*irzeVGsyHVu^6(@)Y8nRU>k>CD=YRj&9` zrECDqDthjfjKA)RD~$V$^VZBm;8+pla(En#sO}htj1kZ3h_dFkKPv1Zo{u<6Vcfbp z`eD$@!ZPITNiLRT$ zO3a<1(OiZoZ;Fo!lTV*D2UT3%E%qk35j=grQhbFId@>k zvm+Au`b2tz_QZt9_s%nFUzxZ?d5v2%p|^4KFvtfmg?8nF?;o(c#a5G9XvSTa2*iJHI%|Rk@nv(VERR~D;KvvHGyQr3EQVxoM zGOFK)W;;%M(4(&lrz_RgdR0T+s{dx98z9ppAJIumT7?_Wy{bb|V08ST$|#aEWW-mW z*M>6_2>GxYgOrL@MnPT=tPz#@!X&yOFw!o1vzqmInSt__+9?8LRPB#y*^2K0I#u?J zivws6eHFCB9@H~Q8}Hl zM5))xoEM)$mOovkYj||CFGtc>%it^MvNl|dZp|w$Ep6S~&^1LYLIe?w^(CQow;K8j z=>d|=y9Aomq{)TG+}bNM3NGWt34e!h!Eh(pnCQM@)CFw4iJ{e`??E3<7{bsh~*EE4y4y7Llx)JhIfQ#TNEsyg| z<}Cmtf7)>X7gj={~7Z$!vT6od(JN_$jplFJ)M_hQ?IcnJM z1}&p!`m^?{Blx{bQe&@G)<^Jw`9fI5t)SE9-xitbzU~!nOWC~T6>LDE^|G*Rz9ioA zif6mscD7r|vS=&^<|pd&gmUpcGA^ZVA2mi|kH*Z}Asw!cf$9)q*f|y3%eSQ5WCh4z z0E@I@;^iFtfk3+7scuWSL<$RSfq9>uXb^J?ipBT*Jal+X-E)=iWpw2G8&6uOwnHiE zv4>)X$o-TZ(DIsm6K1V@urd{G7!>0u_{oly{o;3x&)@}!zEZwm8C2r6{Em>=(Z#A7 z$~|z+DrBeoe1!j*f?qlt_QPbjEYIp&$mAPHcM9FLF3q^oSCn>;q3|7$0V+6Y@Eq|W z)I?BSzKBi;{?XtQh9yUN2RXh;qLKdGHW>xKi&6zrO*(DdoZ)xd84}DCyr>>w!iD}G zX>(ha!t?nQn}1LKLv6NOZVtoaYsQW<`(AZsABZBpZ4JmlT^?N>AW98N;(vuLXhBkJ z7DFni6vTmdJcNnb`&pLCih?ly)qydwgVktS4+|kMFuw+bzi90r$ z7W^~FxEbDmH3bLL_I9nS%Uhl|R{tMq$tq!hLt1>q=Y1ZD|?5(lIpM2hqzZ5rPyAvc-6|Ht|orQU@ zlt=#p;Vny!_EB@l9ar1%`As(sEOZZPZG@h%! z_mdsIi%x0ehD*GRzZ&k8rSoXx9J;#rlsYe1{iX)#*o`^f`kMjctWE=dwMHE zEW2IOHP}xZTU12AbBbK%Cv6!63nS+Dii#ZqilB^Q4*g!The&f)}%nhLnxk z)3#B9P{cJ8*W2z%`Wr~T%)X5&kN!A1Q?#MnMP)Yf3MLnbicWF-xq>pL%m_q&ShB!S zM*;`LLYxH$IZD`j;%Z*@J&%LSuV`n`AQDq%FaKrl(2-0``l-9*(vaD8CAjeGbh zyc4j{SR7445Z~L=U-{mAoarmYsR|zacY_Niwv{8!){dWOD8n!w#=>N51nT3mpGP`V zgn>}SC;~~TJs}h7^v*_;=CuZDBeVL@4j%H0d>~`O0G}Tu$r}97!J)~{sIgP&nFleB zKjXlm7oM~dWlkqOhrVKVLLH7RF|G077fwruSW2r(UykP7ty5$w@w0|-kLr8jyJn4S z>MWZxI=N5*#)2Oz2h6)F*hW)8SWjdu3@T~U7Npwb0UAJ$D-rg|+`q)jSxp>fZs6TemuYcMAnr_xGYnE2|CZu)1vL zwuwh?X#^MiOQyDQ1>B;~Blt2{YrY>Zd^B2TsL(P40ojBkoRFrPRF6*%d4lI5+ChUJ zeP-^|m4N1gZ!w(SI_P9Ny@xA3{|8oVJ`a9=iI0GDF#qEiCqr$FI4qhmOPVQR>jS4C zFewF2zupH9(lt4nCs;5$fa->Xm;s$@>YHAckO~dw9BVTd#$m-{B3`{bI^)Xr*KS9! zBDZ7jRhrVfcUQHj%_?s%GZRb)w1uk#4XaaOdFOYCd8U=HjL5s-RO%8d$(39G%IXa` z25=#)lDS@081<$G7Um!*SK3Q*d|&`3T<%hzZt!#hn4m}39qV2a!Ju|veYlmcq8teL z5NljWrp3y;#477C0ZxRs`DI}#!qH-&sadBsW0F>-h^Dt~;R1~dW8OKE-wdd@&i z41}71m`#Y7`>o+?7#~oh-vMmP#`Q5p-|(8DKcOBhF+D%dBlQ0bnLcLkwGzZh1h*{^ z8bqf)WK#7`gO&DaaggB)u#UK<)vx?fSsXbH_=E=%mmLkU$nh`}p+-i5-ZfWWNlI)| zWZF$mZw8fhQ)L#cIzc@e#&$e?ky!JBd6bklc z2tzwfqF-*vH4ObY;d%Be?6to_VFe4(r)r6zVvF3%mbc-bP2EkVAUtPr= 2.1.3.1 , containers , random - , nanovg , linear + , stm + , nanovg -- Directories containing source files. hs-source-dirs: src diff --git a/src/Commons.hs b/src/Commons.hs index ff60770..8544682 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -59,3 +59,9 @@ updateHaskelloid sec has = { hPos = hPos has + hVel has * V2 sec sec , hRot = hRot has + hPitch has * sec } + +clamp :: Ord a => a -> a -> a -> a +clamp a' low up + | a' < low = low + | a' > up = up + | otherwise = a' diff --git a/src/Init.hs b/src/Init.hs index d3cd264..8f8b200 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Init where import Affection as A @@ -10,26 +11,39 @@ import Data.Maybe import Control.Monad (when) import Control.Monad.IO.Class (liftIO) +import Control.Concurrent.STM import System.Random - -import NanoVG hiding (V2(..)) +import System.Exit (exitFailure) import Linear +import NanoVG hiding (V2) + +import Foreign.C.Types (CInt(..)) + -- Internal imports import Types +foreign import ccall unsafe "glewInit" + glewInit :: IO CInt + load :: IO UserData load = do + liftIO $ logIO A.Debug "init GLEW" + _ <- glewInit liftIO $ logIO A.Debug "loading state" - liftIO $ logIO A.Debug "creating NanoVG context" - nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) + liftIO $ logIO A.Debug "create context" + nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) liftIO $ logIO A.Debug "load ship image" - mshipImage <- createImage nvgCtx (FileName "assets/ship.svg") 0 - when (isNothing mshipImage) $ + mshipImage <- createImage nvgCtx (FileName "assets/ship.png") 0 + when (isNothing mshipImage) $ do logIO Error "Failed loading image assets" + exitFailure + subs <- Subsystems + <$> (return . Window =<< newTVarIO []) + <*> (return . Keyboard =<< newTVarIO []) return UserData { ship = Ship { sPos = V2 400 300 @@ -42,6 +56,7 @@ load = do , state = Menu , fade = FadeIn 1 , nano = nvgCtx + , subsystems = subs } diff --git a/src/Main.hs b/src/Main.hs index c132847..d206e91 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Affection +import Affection as A import SDL (($=)) import qualified SDL @@ -9,6 +9,10 @@ import qualified Data.Map as M import Linear as L +import NanoVG + +import Control.Monad.IO.Class (liftIO) + -- internal imports import Types @@ -18,7 +22,7 @@ import Init main :: IO () main = do - logIO Debug "Starting" + logIO A.Debug "Starting" withAffection AffectionConfig { initComponents = All , windowTitle = "Haskelloids" @@ -49,7 +53,10 @@ handle e = do draw :: Affection UserData () draw = do - return () + ud <- getAffection + liftIO $ beginFrame (nano ud) 800 600 (800/600) + smDraw (state ud) + liftIO $ endFrame (nano ud) -- GL.viewport $= (GL.Position 0 0, GL.Size 800 600) -- ud <- getAffection -- GL.currentProgram $= (Just . GLU.program $ program sd) diff --git a/src/Menu.hs b/src/Menu.hs index 389ee59..1976332 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -12,7 +12,11 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Map as M -import NanoVG +import NanoVG hiding (V2(..)) + +import Linear + +import Foreign.C.Types -- internal imports @@ -20,23 +24,10 @@ import Types import Commons handleMenuEvent :: (Affection UserData ()) -> [SDL.EventPayload] -> Affection UserData () -handleMenuEvent loader es = - mapM_ (\e -> - case e of - SDL.KeyboardEvent dat -> - case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of - SDL.KeycodeSpace -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do - ud <- getAffection - loader - _ -> return () - SDL.WindowClosedEvent _ -> do - ad <- get - put ad - { quitEvent = True - } - _ -> return () - ) es +handleMenuEvent _ es = do + (Subsystems w k) <- subsystems <$> getAffection + _ <- consumeSDLEvents w =<< consumeSDLEvents k es + return () loadMenu :: Affection UserData () loadMenu = do @@ -47,6 +38,17 @@ loadMenu = do when (isNothing mhaskImage) $ liftIO $ logIO Error "Failed to load asset haskelloid" hs <- newHaskelloids (fromJust mhaskImage) + _ <- partSubscribe (subKeyboard $ subsystems ud) + (\kbdev -> case SDL.keysymKeycode (msgKbdKeysym kbdev) of + SDL.KeycodeEscape -> do + liftIO $ logIO A.Debug "seeya" + quit + SDL.KeycodeF -> do + when (msgKbdKeyMotion kbdev == SDL.Pressed) $ do + liftIO $ logIO A.Debug "screen toggling" + toggleScreen + _ -> return () + ) putAffection ud { haskelloids = hs , fade = FadeIn 1 @@ -70,3 +72,41 @@ updateMenu sec = do { fade = if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1 , haskelloids = nhs } + +drawMenu :: Affection UserData () +drawMenu = do + ud <- getAffection + let V2 sx sy = fmap (CFloat . realToFrac) (sPos $ ship ud) + liftIO $ do + save (nano ud) + sPaint <- imagePattern (nano ud) 400 300 20 20 0 (sImg $ ship ud) 255 + beginPath (nano ud) + rect (nano ud) 400 300 20 20 + fillPaint (nano ud) sPaint + fill (nano ud) + restore (nano ud) + dt <- getElapsedTime + liftIO $ + drawSpinner (nano ud) 100 100 100 (CFloat $ realToFrac dt) + +drawSpinner :: Context -> CFloat -> CFloat -> CFloat -> CFloat -> IO () +drawSpinner vg cx cy r t = do + let a0 = 0+t*6 + a1 = pi + t*6 + r0 = r + r1 = r*0.75 + save vg + + beginPath vg + arc vg cx cy r0 a0 a1 CW + arc vg cx cy r1 a1 a0 CCW + closePath vg + let ax = cx+cos a0 * (r0+r1)*0.5 + ay = cy+sin a0 * (r0+r1)*0.5 + bx = cx+cos a1 * (r0+r1)*0.5 + by = cy+sin a1 * (r0+r1)*0.5 + paint <- linearGradient vg ax ay bx by (rgba 255 255 255 0) (rgba 255 255 255 128) + fillPaint vg paint + fill vg + + restore vg diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 5aad6ca..920489a 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -30,6 +30,6 @@ instance StateMachine State UserData where -- smEvent InGame = handleGameEvent - smDraw Menu = return () + smDraw Menu = drawMenu -- smDraw InGame = drawGame diff --git a/src/Types.hs b/src/Types.hs index 3c72a58..11ba3ae 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -7,6 +7,9 @@ import qualified SDL import NanoVG hiding (V2(..)) import Linear +import Control.Concurrent.STM +import Control.Monad.IO.Class (liftIO) + data UserData = UserData { ship :: Ship , haskelloids :: [Haskelloid] @@ -17,6 +20,7 @@ data UserData = UserData , state :: State , fade :: MenuFade , nano :: Context + , subsystems :: Subsystems } data Ship = Ship @@ -48,3 +52,43 @@ data WonLost = Won | Lost deriving (Eq) + +data Subsystems = Subsystems + { subWindow :: Window + , subKeyboard :: Keyboard + } + +newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())]) + +instance Participant Window WindowMessage UserData where + partSubscribers (Window t) = do + subTups <- liftIO $ readTVarIO t + return $ map snd subTups + + partSubscribe (Window t) = generalSubscribe t + + partUnSubscribe (Window t) uuid = + liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) + +instance SDLSubsystem Window UserData where + consumeSDLEvents = consumeSDLWindowEvents + +newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) + +instance Participant Keyboard KeyboardMessage UserData where + partSubscribers (Keyboard t) = do + subTups <- liftIO $ readTVarIO t + return $ map snd subTups + + partSubscribe (Keyboard t) = generalSubscribe t + + partUnSubscribe (Keyboard t) uuid = + liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) + +instance SDLSubsystem Keyboard UserData where + consumeSDLEvents = consumeSDLKeyboardEvents + +generalSubscribe t funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return uuid From 66499d07e4029e546e7402855c9a5a7d3e4b052a Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 08:18:57 +0100 Subject: [PATCH 25/35] haskelloids in menu --- src/Commons.hs | 61 ++++++++++++++++++++++++++++++++++++++++++++------ src/Menu.hs | 39 ++++---------------------------- src/Types.hs | 14 ++++++------ 3 files changed, 65 insertions(+), 49 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 8544682..5bb86aa 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -14,17 +14,19 @@ import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) -import NanoVG hiding (V2(..)) +import NanoVG as N hiding (V2(..)) -import Linear +import Linear as L hiding (rotate) + +import Foreign.C.Types (CFloat(..)) import Types toR :: Double -> Double toR deg = deg * pi / 180 -wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) -wrapAround (nx, ny) width = (nnx, nny) +wrapAround :: (Ord t, Num t) => V2 t -> t -> V2 t +wrapAround (V2 nx ny) width = (V2 nnx nny) where nnx | nx > 800 = nx - (800 + width) @@ -41,7 +43,7 @@ newHaskelloids img = liftIO $ mapM (\_ -> do posy <- randomRIO (0, 600) velx <- randomRIO (-10, 10) vely <- randomRIO (-10, 10) - rot <- randomRIO (0, 2*pi) + rot <- randomRIO (-180, 180) pitch <- randomRIO (-pi, pi) div <- randomRIO (1, 2) return $ Haskelloid @@ -54,14 +56,59 @@ newHaskelloids img = liftIO $ mapM (\_ -> do ) [1..10] updateHaskelloid :: Double -> Haskelloid -> Haskelloid -updateHaskelloid sec has = +updateHaskelloid dsec has = has - { hPos = hPos has + hVel has * V2 sec sec + { hPos = wrapAround (hPos has + hVel has * V2 sec sec) (100 / fromIntegral (hDiv has)) , hRot = hRot has + hPitch has * sec } + where + sec = realToFrac dsec clamp :: Ord a => a -> a -> a -> a clamp a' low up | a' < low = low | a' > up = up | otherwise = a' + +drawImage :: Context -> Image -> V2 Float -> V2 Float -> Float -> Float -> IO () +drawImage ctx img pos dim rot alpha = do + let (V2 x y) = fmap CFloat pos + (V2 w h) = fmap CFloat dim + save ctx + translate ctx x y + rotate ctx (degToRad $ CFloat rot) + sPaint <- imagePattern ctx 0 0 w h 0 img (CFloat alpha) + beginPath ctx + rect ctx 0 0 w h + fillPaint ctx sPaint + fill ctx + resetTransform ctx + restore ctx + +drawSpinner :: Context -> Float -> Float -> Float -> Float -> IO () +drawSpinner ctx x y cr ct = do + let a0 = 0+t*6 + a1 = pi + t*6 + r0 = r + r1 = r*0.75 + (cx, cy) = (CFloat x, CFloat y) + r = CFloat cr + t = CFloat ct + save ctx + beginPath ctx + arc ctx cx cy r0 a0 a1 CW + arc ctx cx cy r1 a1 a0 CCW + closePath ctx + let ax = cx+cos a0 * (r0+r1)*0.5 + ay = cy+sin a0 * (r0+r1)*0.5 + bx = cx+cos a1 * (r0+r1)*0.5 + by = cy+sin a1 * (r0+r1)*0.5 + paint <- linearGradient ctx ax ay bx by (rgba 255 255 255 0) (rgba 255 255 255 128) + fillPaint ctx paint + fill ctx + restore ctx + +drawHaskelloid :: Haskelloid -> Affection UserData () +drawHaskelloid (Haskelloid pos _ rot _ div img) = do + ctx <- nano <$> getAffection + liftIO $ drawImage ctx img pos (fmap (/ fromIntegral div) (V2 100 100)) rot 255 diff --git a/src/Menu.hs b/src/Menu.hs index 1976332..3fe5be2 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -34,7 +34,7 @@ loadMenu = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection mhaskImage <- liftIO $ - createImage (nano ud) (FileName "assets/haskelloid.svg") 0 + createImage (nano ud) (FileName "assets/haskelloid.png") 0 when (isNothing mhaskImage) $ liftIO $ logIO Error "Failed to load asset haskelloid" hs <- newHaskelloids (fromJust mhaskImage) @@ -76,37 +76,6 @@ updateMenu sec = do drawMenu :: Affection UserData () drawMenu = do ud <- getAffection - let V2 sx sy = fmap (CFloat . realToFrac) (sPos $ ship ud) - liftIO $ do - save (nano ud) - sPaint <- imagePattern (nano ud) 400 300 20 20 0 (sImg $ ship ud) 255 - beginPath (nano ud) - rect (nano ud) 400 300 20 20 - fillPaint (nano ud) sPaint - fill (nano ud) - restore (nano ud) - dt <- getElapsedTime - liftIO $ - drawSpinner (nano ud) 100 100 100 (CFloat $ realToFrac dt) - -drawSpinner :: Context -> CFloat -> CFloat -> CFloat -> CFloat -> IO () -drawSpinner vg cx cy r t = do - let a0 = 0+t*6 - a1 = pi + t*6 - r0 = r - r1 = r*0.75 - save vg - - beginPath vg - arc vg cx cy r0 a0 a1 CW - arc vg cx cy r1 a1 a0 CCW - closePath vg - let ax = cx+cos a0 * (r0+r1)*0.5 - ay = cy+sin a0 * (r0+r1)*0.5 - bx = cx+cos a1 * (r0+r1)*0.5 - by = cy+sin a1 * (r0+r1)*0.5 - paint <- linearGradient vg ax ay bx by (rgba 255 255 255 0) (rgba 255 255 255 128) - fillPaint vg paint - fill vg - - restore vg + mapM_ drawHaskelloid (haskelloids ud) + -- t <- getElapsedTime + -- liftIO $ drawSpinner (nano ud) 100 100 100 t diff --git a/src/Types.hs b/src/Types.hs index 11ba3ae..584c1da 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,17 +24,17 @@ data UserData = UserData } data Ship = Ship - { sPos :: V2 Double - , sVel :: V2 Double - , sRot :: Double + { sPos :: V2 Float + , sVel :: V2 Float + , sRot :: Float , sImg :: Image } data Haskelloid = Haskelloid - { hPos :: V2 Double - , hVel :: V2 Double - , hRot :: Double - , hPitch :: Double + { hPos :: V2 Float + , hVel :: V2 Float + , hRot :: Float + , hPitch :: Float , hDiv :: Int , hImg :: Image } deriving (Eq) From bc8cf3cd8cc72b03beaa3d152cb8e1a1461d8a8c Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 17:29:31 +0100 Subject: [PATCH 26/35] converting font --- assets/Modulo.ttf | Bin 0 -> 21740 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 assets/Modulo.ttf diff --git a/assets/Modulo.ttf b/assets/Modulo.ttf new file mode 100644 index 0000000000000000000000000000000000000000..cfed4fc5a50328525d4aa025ce925912858ad2eb GIT binary patch literal 21740 zcmd^nd3;nw_HR|)PC5zMI^CVl0-=-6h9V^CgkXp$kg#4tWD^yk69|ij&@>T&f#@ik z{7?Zmh5;s^qx^(nSDX3{FXN1{1oi+^n1Ar#u_I>}tju9->^r#Ibx1|!VCDCg2F6A%!gZe^ z)uYBFE$SP=Sk(r`B8!KN88`6OC&ur?b8PJVs4=~ZmhPP3VvNtnwQtI-8vjju-pXJs zVjW|mYSs@>`CZetX2z`VHS_(vl$GLq0?NA^YG&2# z^8~UP8+01@{=+|eZsX@~{{Cl-4M+dPGmQFnJAZE`F#ZE(IeQv!GwWuPl#9NcuB<|FyjHH7jPI7JgKd%X_!bC4Pc`%va;7 zMH~<-alJ}E^1rbnc3GA%b`LPN^A@0N-t#XA%w@MQ_fJB{K{>(ux*508bN-z;fP)** zcj)E$NZiFaPiED;g=GNaF5)_tAeJ$!*uorKWf{B)&ze{{U%?Xi?^qLgp0r1AY_k9cS@kIkSnOfN`9q$~LB=?n9`T3wRH)eEuaXSNgMj zQO-DD37FfNjqk_t2#e!yvUGl$*=1WF1NJr+AtvD236`Veut@PdOA(g+_n0d0D+L=g#^zr>RGA(Xj-XH~2k zxa$4#p}r0D1MNf^;~h6;1B>9#f{raXhHoE$hT&U~Wr&}HhVQVLP8-@6--7;!SXTHZ znpii!2=(@1D?^_u48#X=(+ca$F(1$Ug;TG^i$L$;R>*v6| zW7{#H?HP;-9plmd7?jzYy*io4ru>`m& zEDBq+Y~a(t(OR>&h%V1<{cS z7UYF|ARohP_!|xPXZd5G{$7MnQddc z*gn8G$PTmffH8oN=03n!3>b$c47)qU-PP@uFm4RN;K5+-XHV_Yl7o~HwXI#^IN}f{q)M7GuzH=J@fpT=gvHHX8oD9XC6M2^~rBOel6l1 zy^p};|LVt~lcAjDkCV=&E&PXviX|e_8WkPWB{nWTA<>p(cQ}(>DXD4cUAtv;cV}jK zvU76t@_Sr&ea{S-2)-!V4R|7RAsciG;3uO0mT9}d0# zJlnbd*zvcHzWd&v*c*R*v+-wh7cFSI|AECzma>QbW7W!Cue@piApPI=OJO~k4?5`$ zc7?}qH}AtI@Or+Gui)$XR{jn@FJeR=Q7!yplh`GGP_mQ?#i#g{CCU@Z0p)^n*^+Om zu+&->S=L(iSl+apv0RDBi0Bnj9dUQWqY>L9PDe&X7DNt=oD}JgTphV1@(+=xB3mM_ zSmUi-t=C!0tpV$!)*aSASWiY-qPj-qM-7dtjq*pWjoKP@JnB+(R&+&lLv&O0hUgv9 z$D@CUNsQ?kGc;y=Odw`i%%+&bG2eD6=rX>`-Cg!{d8f<8E|+7oV*AIcu??}CVqcCu z6MH!>DXv#sRouL|C*od?I~n(5eAjq2en$L~_-EtaiT@!XBVl;Lyo6^HK1fVT?3p+% zab@C;#P@AcwrpFKZK3T6+YZ~Cwu?!Qq=KZ;NexLWlU_*rAn9U~W_Q^8+UxC)+7H+- zI?^0fj#Z9*j!RC5v&>oRT<3h*c`7+3IW4(3xhi>K@{Z)Qu4LChSFLM>>vygN<1ar5>HlcaUZYUThymG_j;b|NbbjR@9(OrW>g0P z)fwi=-5G_Im4z8+uw@jA1GwE1Xbu>M*434@mH()%B+pXzUNoV93VLd1%*(ypq@FOS zXcaDB>lZ&sI{sen#evp}*^-?6U3s8B2`R!#I~7*Gu}=iYE`s!qiU=n|T*spp0YiGVP@(T!=MCwUd1lw^seKq6R(zU_`Rzd>`y7_^VWotv=rS zckfnr?_N$jb+>E_cyX48@nJ4-Uji^%N4=wGIlM1F!I#i8d!{ophwsov^ChZ$Cgp*_ z-)fTvT@rLLkY!L$ERIiLGm|SeE>h7Atwgv~?QNW?pyg`*m^KHv5Itw24rGjQ zAq;GpZ35n1$DR+@%B3i%=o^NT#FqLZ;L9`qBI+kXx)?M7$UviU6E80HaIa!ehz8|b z4hW!1HjnWo=mR5S(H#jl&dMigk$PitWQb1SW3d#lBS`);(G?s2NV{L8wYCVq3T_}h z0UCg59jpC!$ zN?L>L#X9Xt)Grf`I-LX6HT}wbqOvz}QNduaSYbhhKzBfkR3LrGq(v!I45%O(!(sJu zj~#6m^}#Lh%xRMr+7BizcD0d0+rlrmkpeaZzT;uhANqnuNwPfASZ97Z(ySY z;_;-UW@Ygy*rnn^j#C2U)qy#d!s2v^1*N3c%gQC$?XA~^2#fV?)i4ItY%#x6+)QIo zng>C5{j_bHZ`-!TpW;X3U(Sy3i~Kvlg+!CIgL^W|rNooeJ5=5ig3nn#;COX7WYzMZ z&io~B6G2waOGRx8cIha;Ni__Dc7zIZ z;%a^XWpT_Qn`49Mgm=ro;(e9+rK;4g7FAmm)-}|pzMVjQ;D(;rGO>BE&rx|Y)ZRsL zfQGZRf`%0R(e?OYy?iN(mVg^;)cWa|nk*%t&rzPKFocY5jn*iJZSJ!P` zDa!mN;u_M3Z}7`nq|{@?n3Dg1lPE{MSgM(+SY;C~yEmHWl;-i%ryo<*$4>jS?|7_M zGI=uZeqf3?F!dGQUE88<`E>DOiKp2w;2`_uM2~7ocN2?)#+XMb%xnXmM5eujSki9u z9B)&@LoY{6*G*CA2$|b%q8Hio`x(^~6YbUGtp4=FNdQ&FaxL zYmXh*KIW6=Y~DO4(A=!Gf-8x|44x!8i6%`id6Hz@W|xvtoJ)cMvA_>Rg-A39z%YIi z&@dbjfq=e{?Lz6pmx}acDTER^KxA5hRw^MeX}quC_J%bNG|w4Zx!t#P0AWXLbZpIv zY5xBG3Blgyc8#b5jzm^-{Nf?Qu=|+`VFoslwgr+eVOyPEe){`v-O5#F{*no@l=Kv(J3m4{#K4uHK>ceqoy|PlM}d>p6A$WT?U@{!h-a?n7qnb{ zs&y4Od$$xT;n({VoWWj&?+&;wbcK{d&N@|Hr!=cqel%!`n1xsXc;w?k=xRegD(+Ex zu(#}a9R}o)bXv*tfT2WP@nJ_mK)c`!@o8`$!H9r+BR(anuG61IqwXbTzl0CBKiap{ zr|jQ}YE%zxlWxJdz$fz9I6n|5;et+p? zkJPW!FGHSY2a^PR;LnP9v~^XR6xgtVboYi0ooy0u6i(FZ!jeEmvhj(KGSJFvla88u z9n}QYP!-%vS_7)N^)x9GgASbZhi;RgHOOzJ`NnXKelNkgwBXOAnJjBqBU#u+C6_Ie z#iVIKU(ERhc&ik1UDEd@($SJ`erSeq6F+ng5@^UGq*5alK(mWBk(G0d!g4fkj9IFV zYX=)O5jN^sFnD_#g)wGxP#(NN<#WhquK*lSO7y^evXzGEYG;#%KhKvvZlLuB-vQX8 zLl~KO5buBv(L(C_bcC)UYq6y5KRN|ONXn!$L(*f?ISX~bZ-fh^LDl6&*WptBrJdt> z;6}R*^5C>*mU{De)YIxYNQU<01?{L>RmGi$+sqIDXuI~Vv_Y=mL!uYpL*61JKij;b zmsX|A{ED+)11_rvnp9yX;=c0xY%5_Nt z6q=QKi`+me`xc+8H+bZykv?|};8YfN56w>d7md!y2&B|q?{c+GQp0Ugl0oQm%${$LK^+m zU2IRLZiV=GNg$pWVwytjYk4mGooo-}j+^?|usz?Y8~L)0()6_19Z;8iCr=4%Go&eG zdDM~t2&w=q{HNB6{CtQ{$o6pHYxvpHFF~069<}ug^o_g`vOb*nQ3P=YyJqJliq{3z z0fh}4#OwGy7kn#VdCuu|w($ZOoQr>?y1Ef!mXQ6>{aQfbc8|gpkDc4Sie2&A`TkSB zQ@jkj))wp*(p7ho3cgXdEb?k2?NOQZkmM)O8nqD?Q4p`e-$(EGnwx#^#5hz3e}N~R zz?j5oQ}{*{580&%s-5G^w0o_`0Od?-9ANHmZ>vhm8M5=t4 zq_QiAb(jvoJa57zo8_|VrmHm1C*i4pOg$iwsy3cL63h(NBChA}lKk3Th&bh0OOEZN zAAc87w58YxK4P1Qg+5`%LX&7F2Jy86^9(tw>yN<1-Es=s`fETF1drc}@wJf$X2dgk zVM8Wip&ZijpFR2HF6uz-^5upuMbKm461_9SFRAm|!~=Lj#f#@e zJt82Ob=qBhiU=?TLaZ()`Ju^nGqv$y~;P19k_ARLaTM*rW+^S)o&x6@oj^B zgCP*2e!;L|3w)EhrmS#f+~u1;bm)BFT`ApGWF$}0&LbLxn2?-kwD~~LhIR^GmU#2X z5wa3}U<)zT_SA3c)@{?&z2p_`tJ_p|QoFR*w|6SdrBKldz4FrbK4bk%wb+|kugPwWFyjoNLaWl8;Zl&DX?S&Vfyp; zOz&34UD{n}m4!0eg&leNGTc(DYYB5s%r6&K$^eX@5D?)lF7cO?so)n#gUMHB3_*{L z9FrWT*d%-Du@1d%65EORUmSD^c@d<$5pk#e|B|fBnLLO%;s*Lj*<*Y87QU49PbnPk zOlJmPq8-`$p1MqjS&sN8*@ZZ1qcTf~GAKt;sa!qW2L;TRX2Ml~6eMgQasSr-7OmHb#PL$j?kr#9lV{R|xu16lsN=|fsQ zkA?e?S-}V8oB)1=UCsogUM6OR8Y!_gfcEhC29&_>kkf%eeTtj^9Pb;&W$J^%9Edj# z1iv_;Nnru){e*PDq|PI~M<&H3jZHtL#Ph)lcyjVbp~O`*sVgkUwYWr6`r-T~+6-xH zk^L^m*t~9z4Tm|kdU|u(^BR&wU%K2=AYT6TI^l67lNS`Cmu}t-b7#bnR6VLGIZ(`$ z%%Od}&YThvZ%I1@8p=3^9`S){4@G@`0h*d_x8a|6s6+E68)hd~k8Z*E{ti{l@+Wj2 zG}?g5a5>G`(iHSB)XH4h>o(k0q8=hNMms{J|d-U3smx$=F6yP(pXj2^8Ui zSZ{EjjB6$9njSjSQ`!savVC;xhMog`6UNnrLR?*LYrNsPDQnCy7i>CYlJAu~Pq8Yp zjwTj3+A(qw;SsCZG!_VFQ`CwN+4;Y(Z*5=yyKB@x0qRow(y!F%Kp`-@9MyIhoS~sL zF;I-5MKAPzG#PMY6f?Xh=IEHmb})N|50(M@m3Ct#g`Xm$~G{i>9%W(GR8LA#uRr$}CPQCZusY_uG`^qqB-(18= zzfixRK&hmScuZL-afC+-xi_L|IfhiWMb)@N3Z~)ChJtIy+sP+lJ3=2L2lfA|kv1Bx z@g1XW>BN?uB5sC$QYdEhZ@{&7hTHt_z@;&Eu(WI8D~G!i#*dH~bjH|Z0261TtwXLf zT`lTpI-i}O*XUZXGyHIUXffzQJVtF~U!w=+^0O&=om$HaW4o*LsT~7K-B-=F@t2TG zM)N7F3+{6smRhhF{nFyaeawIUk$Hw&kO$1;1VU+$hBS)rd8O;+h3Dzj*BPKdvy1aM z0-@aD;uHnFX?Xq7H8o@Ne8XoQUsF3KmtPvCz0_|+KwDhJhu<<}PIJxlr`8ohA^534(o`K zIBO_e#pqiTV7X)rr~_8n#%#qL^bm&H%COPyjH;fEAd7fp-(}1aG?XhTX4DdsK2KQW z@+&E3X7p0myBV;LGvI4U?dLLMc~CKiU*j~R=G{4dYCoEw^urHcmbw=Pjw@O#oU6V3 zOBp~1E;MgrGA00=a?FJ`eG%PbguD#kMpR&hF)D3K!EcZgr$y=ur1Jn@_7Nssl%tQ* zXOa<0_&-pEdX%#D3+kS+S{Cw|u3872px4nFu3g9Qn~Zk!Q8#M+g0za+lBrANS{U#% z{3fHG={FfQuOCRiP~C7nVXO_n7Lnft&eLPCtRsgQz5OzbKSJ<2>j3KiFLd8Y!h^Tq zqRs2nNzmAOcps(=`(Aun2ZA9*WD~Jh_}~EHYCeNIt_7u*@4!I z5U+yCS%-2~l(S!@9G`@KBEwaWoGP+^539MdV}NM(3egz!X&U-u<~yPFj(vGV{cF2U zpnm%vfQ7&Z6ZlEw;U?0ItSvrjScZsFvIK}s=$Qz4R=y5G8>sG)H`>=&tbMS;mH>&a zt#nOqi6z~$v^I=?8!K{D(l&sWQ8q3Fg*3E9YO*+5gbEh$-9 zGQDMu%u~tAYC^O_q4|sIDlU z;#=(sR1Yed>RX$Fz}9Q->k2Dd#B1HJM@WW<*yHD~USEXcbq~IFL+_`p|4gs^?S>!I zXboDftAc-RrvK4C!fkj&p(wZE6Sa$Uck+oOtZ<*mTU6@whI>U6l-Vg&O}oHMzBtg) zFR~G3J4fCPzPv*XVRj#wvSSSXD!!2oEB~Zb!h9ngyK8tygsJu)VZ71aKgtKno%|yi zLkCS`X*DsOTS*Oj^Xwk@#Bh?j$RK(Q#nbodB+w)2aTHZY_mLk6Kj|p^B$+iz5$;a@ zk@_q0jedn6^ckYx9sMHGz=-1`o*1joHQHf;kd_Qvn~q=@M)vkS4a00)IQL7xi+zp! zNboFXoCuUe$f(beuv6C05TGwFr5@wc6;OK3>Hev>yf@ zx}d&OX4K)7<4Sd?0(=2fz;eLfP-S;(Pv0t)@6n6D%p1tuSV-q80n{N{%Nb^llM-*d zPMIGU9&X_CX(blRu&;(kPr_1+cwaaMu&aP8=hV`#bV*4J^C#p25GBPy9&LJVhHi`a zcyrB`mV_woNLf!%^oFT^0Bb`K!F=swJrxqq(2mTdfPGCTuFQcKp(l&!D_KZD#wr&j z13DsgyTm6@5-$KrI~F?C4ubo4suc7?gT_HwF5|vLC!w#MneF_m)iXtEAGV#&BIYzZq*xz~3sl!^nQnC(G?}AQXun z+mZz^$5r0_q9-C`b{FIi$tD3hF9IP62Kf!P1-PIGKj|mIw zkU=4k8iQ<2Lyz3V^=vB40Fj>%z6#R~PxxxX=!X_!o5-V$3`+AZN)~ z4``J5BBD=m)IS2BkgtWDUpx;O&*g|Y2w~-fjwR$%e8r;_ymJIuGHh(UG^)zOVfGVw z7`(4Y2+woAs3jwo2cFTNO%8h|%32Sb&!WUIb{VmGczu-9y&n0OVwg;x=2(;;#(pxM zL4JS2Gd*n_Fe!)g>N(c}@2(Bw&&YbfnquXd*!Un+57K)B1Yf>4kc4v2hRUG@`F?=~ zMcTh#Ky7W7`Q3n*W0vD)xjYF@;LHO%sY0Uu% zDKfeSJw+OjQd49dxtOt=e|Pz^`h=>rAc6D=NzXKPlIP)_Ens8HL)s{RRh6IT(S8*9 z09nBnaR+kCDW43w4JukHe@~XFtlRGBK16EDL8-G3B2Sj?=&7XPE(hASP@7@zA^`H$ z-bP3^3`6I)626xJDStz^cE-C2f0sf^yi$#IjuN@fp}(C_%1b0G>Z?vb0cG-0CQdIy zJY)6zM!Jh~@q?a&m#&dBujjab3Yo(^kLHM3xwK43i&8lB=lXgbEfyjx8gouh2IsFL zh4jVj$yGvBP0rpI$j%bD63xnW4s}rN*fc&DU$%X z>eDGHn-&oC)Fe8i#CYu&k~YY?;aZ!lRZAOX${~p32R^XrnUs4g*)7w?v-d7rrt%R; zW>P6tPv+KuJ|YukVMD{qLJJwCcZZ521yhfol%PE9xSX?d{+AAUSh5V>Zck5;lbQ3HwQer9pYBls2(xoI{DabLPco}jJGu!N~ ze2YOQZj&wcf~UlvRqb|ZciU9Aw7}vGBr3x08fu;npo`4wm$2JbaY#?doMT!^$xs%) ztxCj3(`XZNtA!s3nmQJgQ4l&Ldxf!-Dh8F|O%V{j=OGm-l16&4pQ@rq?Q(=Mrj{Di zN3LsTNuCXvhyZ!!L}#y!-;c!J zE8l>+z=blsR!iOh4l=(5F(w|$ZE+fF3WN|JDpOqaL|wu|90<#D*>0xnYB@j#<5kUe z@f{+bc(D{zsOFP)5hu#Fir6N;S9A~8uSIj3{r+a2K>Inwt3{}P6lD-8;r2`xJf=+( z-L*Bc{s6WJYqbLWgb*c*N!P<< zFu=vyKJ?xW=sg*eA*{L6TLR3rONX&w05M8Be3;4=v5mk#18qQ(ObdZG(MY7S^q%BY z)D9X{%j0E#zOAjmC7O_RccNbzI0MDevz$Du>>S5yGa^GpIIiL$f2de*F21XGv$E$B0_$ux4n^q{KK#>X3eCM7bog-^9eqn;qy2F)^Uy~x?T zy4JJ;j7)-Pr!Ol64@y-jL$Z`zLBUz6DzVs0@R6Y+*ID5^XWA%T55|NteUL?3^n&W} zVRP_FpS1p7Y)(IOMmvyZ@CU_;4ZLKeo#xM>lmSe&jl3@0<>OUDkLz#D;B}>f!LRb5 z#tAb$jes!IR|N(FCl7FX9({&iU?#}udRq4e`JJE_v^8{t@ix^wl2-Y0#tQ0FIa@52 z;oXubj0(9uTT9`?MTQEtC5KpkX0asx%k1~TKol;o3^6_X@ z|Bb<0;`%w>#p5x?IdY+Rrg5&|J^7Kwxdmlr8RrowLtYmBB5{Acac*S;M2>MD#qz{{ z<2;(>DZP#J7&b-;8t1XhX1UKek7MbU*NyXdc5}pCz@1y5yV!Hs^mEEBykeYVu7Ph{ z==b4|@gByx1@He)HqIkZrqMW$#Qjyqxs^Q#k5jK3#j3<~<2)MYpBU#c>^bE&<2;sS zS;iRWajcK!VdFfWHCg_~2C>=9&la!%o5`lL8LW}H!TVEK4;+i|rdT2V-0&3_U_XvE zu&JyLWvft&YBr#J0LOYZ7A5>Rn}+RPSuP;!ITF2(2{vg1w!7JsnQL6{*g*)`D z9>=!U=gO-(HdnSY5BsSo$p+2FmqKPvpV8>fpVGr!R8Uyxu3g|B*D$p%P&Iqd?1sj` z?E0|_{IjRczPDj&V1YY-Kz-eO_n;Xy^JX{p=;aZStdNMJG* z*w*97M$VpkZ#|Bq(d2Y_vj%9f(RI`Bt*^n!U^WWf9?Mi9J&={*YAo(mvI$VVqfl!s zij1lns}2}gHfrqP$_dq@M&s61n<$WU?S(zjmlYHg_QH0J!r>6y7$hQ44K^ZtjU0|y zI0o1~xJTswpC2ZJH13&m-8JsUK+V*;Sv7%s+_R_s+w^Du!>q&p&4K@a*Y5w%Vs#&* zzh2->R+#17%LAKnGB|jvv0cV53&!k}7xIYsr ziSCkGAO$rFPgN)pHfEUW9_6oVa1VwOaH}(?)HTelbLWp5tl}Z5vqr!xW4-Y=7cfZC z_;GJ8@SBVCdK_ot?sPn#!e-%K$8x<Ges;60*@!!n0bwe;33vtMywC=(Oz%Bq)?D*mZ-347x?cVn{+s8{Y^<9+bLveE zfw?ntaYP4TIrOzQ7JLZ0_-eneag(Ezg4uTjteF+IJsSBLU0`eC5RXbg#L|X$A?%m| zIgz>JLViptG9l8Dx6uv0Q+E(E6Y+TuB9J+liROW{J=k^lfdS5fIs3tvxQX=#DQ9KH}rmOaECXOFO_@$Hxw*cSF1 z_Gk7dwgXmZHOT!I2!DjV$=+s1*)evUeF2s_fv*$2%XVUzzGiFK2kd?J7Yx;x>?`&# zyBmXY4~Dj$HDjpfU;t^b?gbOf1DjriWm*VJ^)t4ZEn+X@yD|5(CiVdPIlgUl37;y%_Kzz717h)7StGre{pT zl-ylEb9xPnCk$yGFWaF#@qHwCoJw=>IlaFa02dGFkS-uOLbx; z9=(B^0H4#d(>Nm^&myrclxHVpdAfHBXV=Sn9~oy>DJQ*Qy-6m@a5o8X{|g-RCAjzt za20(aB3qUs8;_+2+@XGEP>UV{ZcqJP9#eEnuVzJK#<#0wFJ&|s^EGy7TdUB z6C02BA|?c1gC2teF}9N651>vY>l?hxZp5>) z;Kz7-{X83lV`cCXAfIJJaDFT9jmB{duE(LyZGd$rj`U5H`N(&Df@KF!f&vLad~Gdw z03%^Tor8d!5G=r*iFiIAEqsd>zC{aEwh-E{1l&@Jvm1dcX1f|{Yll&GDkzzQr&-Wj zHfW}l>Vx(xlF!U}?qfYvXdC&y7@6MBCEy}!Wvq0Mq^5$NxasF8#k z<543XSp6f^&lfNz7tohHjM8<%20UAewiW=AA5V?|r)d(KWq_~+xTWCfPCT83al>~7 zflUfa46en~0@f{v@2dreqn-J3WO~Ae6ak}hV0tTRx2G8OvjFrgL7z%tk79u5K)|ZN z*fapv62Phk2R?^ZbAa1gz?u#?>tNLqv~rZZ1tsrB$tJy3tr;bjf!?2^)Y?w)9z>}s zzPN`IDU^6e(rOo|aR{(lP@)AbybV~N;K^Wc_K@IDke{znel@#2xC(V% zAWYG=EqD$ZDjBvj5xD#ST@?>poREjF!I=)&%v?~=l(YoxJJi5xYw!)UumvS-61#c0 zyB4i{4;UBO2pp>c?^a-VCwPH_Pk(|;RAS_+(bhO%H6BNS8W&LNalq&UtcHL>BhYpg zBx4*nVtnw=!1gJ?SdH3)fZeUZ#pw58+?fG-4Z}7b5_cP9c|!0HxO-Ic2K8zN`hAcM zC5(W7HMa4=tthn)5T9UopyZw4bx63j5aYQCSLe}k0_c(m__p9KjPQDl-C?wQ9wYSu z;9Ug1=h4HX=;1#>>GN_dM&Vc;{0_Kn1=Y?&i@XV1pGOb&1G5Vx3BeVB_$=;h1s1D- zK_c!B0&YX#9}UO(2&qwa0iVI3R5f}r9vju%f|`3!_6*woC))U0-ffl`N(i9w@F3Z< zAyWPmg7J8kFR3*|Qfxb*4gp7u0K{7{;`Fwb%vuKrP}Cw@T90!0Q>oBLBjB5jgvaE; W*iIz(7A5fe%U6{z(=q&8p8pM^AKbA3 literal 0 HcmV?d00001 From 27179fd2256dc8736ecf72deb91cf56cbdcafddc Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 17:30:44 +0100 Subject: [PATCH 27/35] menu looks good --- src/Commons.hs | 26 ++++++++++++++++---------- src/Init.hs | 6 ++++++ src/Main.hs | 5 +++-- src/Menu.hs | 19 ++++++++++++++++++- src/StateMachine.hs | 6 ++---- src/Types.hs | 1 + 6 files changed, 46 insertions(+), 17 deletions(-) diff --git a/src/Commons.hs b/src/Commons.hs index 5bb86aa..4628ca4 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -25,17 +25,18 @@ import Types toR :: Double -> Double toR deg = deg * pi / 180 -wrapAround :: (Ord t, Num t) => V2 t -> t -> V2 t +wrapAround :: (Fractional t, Ord t, Num t) => V2 t -> t -> V2 t wrapAround (V2 nx ny) width = (V2 nnx nny) where nnx - | nx > 800 = nx - (800 + width) - | nx < -width = nx + 800 + width - | otherwise = nx + | nx > 800 + half = nx - (800 + width) + | nx < -half = nx + 800 + width + | otherwise = nx nny - | ny > 600 = ny - (600 + width) - | ny < -width = ny + 600 + width - | otherwise = ny + | ny > 600 + half = ny - (600 + width) + | ny < -half = ny + 600 + width + | otherwise = ny + half = width / 2 newHaskelloids :: Image -> Affection UserData [Haskelloid] newHaskelloids img = liftIO $ mapM (\_ -> do @@ -58,7 +59,9 @@ newHaskelloids img = liftIO $ mapM (\_ -> do updateHaskelloid :: Double -> Haskelloid -> Haskelloid updateHaskelloid dsec has = has - { hPos = wrapAround (hPos has + hVel has * V2 sec sec) (100 / fromIntegral (hDiv has)) + { hPos = wrapAround + (hPos has + hVel has * V2 sec sec) + (100 / fromIntegral (hDiv has)) , hRot = hRot has + hPitch has * sec } where @@ -75,8 +78,9 @@ drawImage ctx img pos dim rot alpha = do let (V2 x y) = fmap CFloat pos (V2 w h) = fmap CFloat dim save ctx - translate ctx x y + translate ctx (x + (w/2)) (y + (h/2)) rotate ctx (degToRad $ CFloat rot) + translate ctx (-(w/2)) (-(h/2)) sPaint <- imagePattern ctx 0 0 w h 0 img (CFloat alpha) beginPath ctx rect ctx 0 0 w h @@ -111,4 +115,6 @@ drawSpinner ctx x y cr ct = do drawHaskelloid :: Haskelloid -> Affection UserData () drawHaskelloid (Haskelloid pos _ rot _ div img) = do ctx <- nano <$> getAffection - liftIO $ drawImage ctx img pos (fmap (/ fromIntegral div) (V2 100 100)) rot 255 + liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255 + where + dim = (fmap (/ fromIntegral div) (V2 100 100)) diff --git a/src/Init.hs b/src/Init.hs index 8f8b200..5066505 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -41,6 +41,11 @@ load = do when (isNothing mshipImage) $ do logIO Error "Failed loading image assets" exitFailure + mfont <- createFont nvgCtx "modulo" (FileName "assets/Modulo.ttf") + when (isNothing mfont) $ do + logIO Error "Failed to load font" + exitFailure + liftIO $ logIO A.Debug "Initializing subsystems" subs <- Subsystems <$> (return . Window =<< newTVarIO []) <*> (return . Keyboard =<< newTVarIO []) @@ -56,6 +61,7 @@ load = do , state = Menu , fade = FadeIn 1 , nano = nvgCtx + , font = fromJust mfont , subsystems = subs } diff --git a/src/Main.hs b/src/Main.hs index d206e91..3ae27e4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -48,8 +48,9 @@ update sec = do handle :: [SDL.EventPayload] -> Affection UserData () handle e = do - ud <- getAffection - smEvent (state ud) e + (Subsystems w k) <- subsystems <$> getAffection + _ <- consumeSDLEvents w =<< consumeSDLEvents k e + return () draw :: Affection UserData () draw = do diff --git a/src/Menu.hs b/src/Menu.hs index 3fe5be2..851b655 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -6,13 +6,14 @@ import qualified SDL import Debug.Trace import Data.Maybe +import qualified Data.Set as S import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import qualified Data.Map as M -import NanoVG hiding (V2(..)) +import NanoVG hiding (V2(..), V4(..)) import Linear @@ -77,5 +78,21 @@ drawMenu :: Affection UserData () drawMenu = do ud <- getAffection mapM_ drawHaskelloid (haskelloids ud) + liftIO $ do + let ctx = nano ud + alpha fio = case fio of + FadeIn d -> (floor (255 * (1 - d))) + FadeOut d -> (floor (255 * d)) + save ctx + fontSize ctx 120 + fontFace ctx "modulo" + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + -- (Bounds (V4 b0 b1 b2 b3)) <- textBoxBounds ctx x y' 150 "HASKELLOIDS" + fillColor ctx (rgba 255 255 255 255) + textBox ctx 0 200 800 "HASKELLOIDS" + fillColor ctx (rgba 255 128 0 (alpha $ fade ud)) + fontSize ctx 40 + textBox ctx 0 350 800 "Press [Space] to PLay\nPress [Esc] to exit" + restore ctx -- t <- getElapsedTime -- liftIO $ drawSpinner (nano ud) 100 100 100 t diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 920489a..0758306 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -26,10 +26,8 @@ instance StateMachine State UserData where -- smUpdate InGame sec = updateGame sec - smEvent Menu = handleMenuEvent (return ()) -- (smLoad InGame) - - -- smEvent InGame = handleGameEvent - smDraw Menu = drawMenu -- smDraw InGame = drawGame + + smEvent _ _ = return () diff --git a/src/Types.hs b/src/Types.hs index 584c1da..8d04303 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -20,6 +20,7 @@ data UserData = UserData , state :: State , fade :: MenuFade , nano :: Context + , font :: Font , subsystems :: Subsystems } From adda5d3dc452658e61c14c05db40955588a5d127 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 17:35:06 +0100 Subject: [PATCH 28/35] typo --- src/Menu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Menu.hs b/src/Menu.hs index 851b655..d9b86f9 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -92,7 +92,7 @@ drawMenu = do textBox ctx 0 200 800 "HASKELLOIDS" fillColor ctx (rgba 255 128 0 (alpha $ fade ud)) fontSize ctx 40 - textBox ctx 0 350 800 "Press [Space] to PLay\nPress [Esc] to exit" + textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit" restore ctx -- t <- getElapsedTime -- liftIO $ drawSpinner (nano ud) 100 100 100 t From a43f9699d62efe7e4cd118373e72d6a018dc373f Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 21:53:07 +0100 Subject: [PATCH 29/35] more beautiful fullscreen toggle --- haskelloids.cabal | 1 + src/Init.hs | 43 ++++++++++++++----------------------------- src/Main.hs | 19 ++++++++++++++++--- src/Menu.hs | 6 +----- src/Types.hs | 1 + 5 files changed, 33 insertions(+), 37 deletions(-) diff --git a/haskelloids.cabal b/haskelloids.cabal index a1be398..e5aac0a 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -68,6 +68,7 @@ executable haskelloids build-depends: base >=4.9 && <4.11 , affection <= 0.0.0.7 , sdl2 >= 2.1.3.1 + , OpenGL , containers , random , linear diff --git a/src/Init.hs b/src/Init.hs index 5066505..fd72a07 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -6,6 +6,8 @@ import Affection as A import SDL (($=)) import qualified SDL +import qualified Graphics.Rendering.OpenGL as GL + import qualified Data.Set as S import Data.Maybe @@ -31,16 +33,22 @@ foreign import ccall unsafe "glewInit" load :: IO UserData load = do + liftIO $ logIO A.Debug "Let's drop some Hhnts for SDL" + SDL.HintRenderDriver $= SDL.OpenGL liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "loading state" liftIO $ logIO A.Debug "create context" - nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) + nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) liftIO $ logIO A.Debug "load ship image" mshipImage <- createImage nvgCtx (FileName "assets/ship.png") 0 when (isNothing mshipImage) $ do - logIO Error "Failed loading image assets" + logIO Error "Failed to load asset ship" exitFailure + mhaskImage <- liftIO $ + createImage nvgCtx (FileName "assets/haskelloid.png") 0 + when (isNothing mhaskImage) $ + liftIO $ logIO Error "Failed to load asset haskelloid" mfont <- createFont nvgCtx "modulo" (FileName "assets/Modulo.ttf") when (isNothing mfont) $ do logIO Error "Failed to load font" @@ -49,6 +57,9 @@ load = do subs <- Subsystems <$> (return . Window =<< newTVarIO []) <*> (return . Keyboard =<< newTVarIO []) + liftIO $ logIO A.Debug "Setting viewport" + GL.viewport $= (GL.Position 0 0, GL.Size 800 600) + liftIO $ logIO A.Debug "Returning UserData" return UserData { ship = Ship { sPos = V2 400 300 @@ -63,31 +74,5 @@ load = do , nano = nvgCtx , font = fromJust mfont , subsystems = subs + , haskImage = fromJust mhaskImage } - - - - -- _ <- SDL.setMouseLocationMode SDL.RelativeLocation - -- GL.depthFunc $= ust GL.Less - -- pane <- GL.genObjectName - -- GL.BindVertexArrayObject $= Just pane - -- verts <- GL.genObejctName - -- let vertCoord = - -- [ (-1), (-1), 0 - -- , 1 , (-1), 0 - -- , (-1), 1 , 0 - -- , 1 , 1 , 0 - -- , (-1), 1 , 0 - -- , 1 , (-1), 0 - -- ] - -- withArray vertCoord $ \ptr - -- GL.bufferData GL.ArrayBuffer $= - -- ( fromIntegral $ length vertCoord * 3 * sizeOf (0 :: Double) - -- , ptr - -- , GL.StaticDraw - -- ) - -- GL.vertexAttribPointer (GL.AttribLocation 0) $= - -- ( GL.ToFloat - -- , GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0) - -- ) - -- GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled diff --git a/src/Main.hs b/src/Main.hs index 3ae27e4..3992e57 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,12 +4,13 @@ module Main where import Affection as A import SDL (($=)) import qualified SDL +import qualified Graphics.Rendering.OpenGL as GL import qualified Data.Map as M import Linear as L -import NanoVG +import NanoVG hiding (V2(..)) import Control.Monad.IO.Class (liftIO) @@ -28,19 +29,31 @@ main = do , windowTitle = "Haskelloids" , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load - , preLoop = smLoad Menu + , preLoop = pre >> smLoad Menu , eventLoop = handle , updateLoop = update , drawLoop = draw , cleanUp = (\_ -> return ()) } +pre :: Affection UserData () +pre = do + subs <- subsystems <$> getAffection + liftIO $ logIO A.Debug "Setting global resize event listener" + _ <- partSubscribe (subWindow subs) $ \msg -> case msg of + MsgWindowResize _ _ (V2 w h) -> do + let nw = floor $ fromIntegral h * (800/600) + dw = floor $ (fromIntegral w - fromIntegral nw) / 2 + GL.viewport $= (GL.Position dw 0, GL.Size nw h) + _ -> return () + return () + update :: Double -> Affection UserData () update sec = do ud <- getAffection diff --git a/src/Menu.hs b/src/Menu.hs index d9b86f9..2436a6a 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -34,11 +34,7 @@ loadMenu :: Affection UserData () loadMenu = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection - mhaskImage <- liftIO $ - createImage (nano ud) (FileName "assets/haskelloid.png") 0 - when (isNothing mhaskImage) $ - liftIO $ logIO Error "Failed to load asset haskelloid" - hs <- newHaskelloids (fromJust mhaskImage) + hs <- newHaskelloids (haskImage ud) _ <- partSubscribe (subKeyboard $ subsystems ud) (\kbdev -> case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeEscape -> do diff --git a/src/Types.hs b/src/Types.hs index 8d04303..c063c6b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -22,6 +22,7 @@ data UserData = UserData , nano :: Context , font :: Font , subsystems :: Subsystems + , haskImage :: Image } data Ship = Ship From 77a81ead3c0f5c25169b3ecafb9ffd247838dbd0 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 22:04:27 +0100 Subject: [PATCH 30/35] removing dead code --- src/Main.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 3992e57..ead72a6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -71,12 +71,3 @@ draw = do liftIO $ beginFrame (nano ud) 800 600 (800/600) smDraw (state ud) liftIO $ endFrame (nano ud) - -- GL.viewport $= (GL.Position 0 0, GL.Size 800 600) - -- ud <- getAffection - -- GL.currentProgram $= (Just . GLU.program $ program sd) - -- let proj = ortho (-1) 1 (-1) 1 (-1) 1 - -- view = lookAt - -- (V3 0 0 (-1)) - -- (V3 0 0 0) - -- (V3 0 1 0) - -- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) From dc1b65e3fa5f85c5884a0adef7095c9dda19836c Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 19 Dec 2017 22:36:42 +0100 Subject: [PATCH 31/35] fiddling around with colors --- assets/haskelloid.svg | 96 +++++++++++++++++++++++++++++++++++-------- src/Main.hs | 5 ++- 2 files changed, 83 insertions(+), 18 deletions(-) diff --git a/assets/haskelloid.svg b/assets/haskelloid.svg index e03949b..33da05d 100644 --- a/assets/haskelloid.svg +++ b/assets/haskelloid.svg @@ -1,16 +1,80 @@ - - - - - - - - - - - - - - - - \ No newline at end of file + + + + + + image/svg+xml + + + + + + + + + + + + + + + diff --git a/src/Main.hs b/src/Main.hs index ead72a6..4a1e68b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,7 @@ import qualified Data.Map as M import Linear as L -import NanoVG hiding (V2(..)) +import NanoVG hiding (V2(..), V4(..)) import Control.Monad.IO.Class (liftIO) @@ -29,7 +29,8 @@ main = do , windowTitle = "Haskelloids" , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + { SDL.glProfile = SDL.Core SDL.Normal 3 3 + , SDL.glColorPrecision = V4 8 8 8 8 } } , initScreenMode = SDL.Windowed From e9a9e2cf7b2c5e23bccfde0e77345876bce01bce Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 20 Dec 2017 02:00:28 +0100 Subject: [PATCH 32/35] making things work --- assets/haskelloid.png | Bin 44788 -> 6424 bytes haskelloids.cabal | 1 + src/Commons.hs | 36 +++--- src/InGame.hs | 250 ++++++++---------------------------------- src/Main.hs | 1 + src/Menu.hs | 36 +++--- src/StateMachine.hs | 20 +++- src/Types.hs | 35 ++++-- 8 files changed, 122 insertions(+), 257 deletions(-) diff --git a/assets/haskelloid.png b/assets/haskelloid.png index f75a4e7d5e45cbb074192a4db23bc4cf0a82e0e2..f633deb21ea3235c53516c2757796e5c2187fdd0 100644 GIT binary patch literal 6424 zcmYjW2{=^i8>d1kNiJEkjigQ1D0}uuDz4OoipVlEHAEOgiHI;QmZoT<6lpboH%x^w zWa*YBnqgv2rmPvsjArpkU__Zj?VTaFR@Q<)KI2}AMIqtSU3jE4|egFkBcg&1A3wSohYux>TB}J&s9f3MwB6^_wUHilmj8#urtw)zQ(E$f zo0E!C@8{EKXk6;kedtrZyW4Yvi&t~cCWl7ubZlun>#-o%TC@LNxZ+}`JEyx$rT4yD zaPzswhrcy1JtH01{Ily`f&2GGVL?7CBZJaI+Xoj09jOX!pYGU}Ffz%GNV4;ibWSi> zPfF?y#3Zn~?w5F-=WjXF9T#`}*vE#p$C|T33z=0@8ka;Uyl=Uw$y;Tv-Sg;EzdF1F z7uk;;Xd=wYp?K6X!y{KOQPt4Z(51(k)c%L#DeZy_kBf>k^7sr!5*61LR%W>1Mr_4U ztj$!~siefgOqGxL_6v5;26UGOX&4#Rh?XeKa{M|vQtXmm-AtV-t&>XbeeUFx7Bj-s z=`V6mRDDxJufALRo}xFP>OH~AcY;0|chFzbYHvr_6-}>{h<|T6qeaKbLKaKuID6?{ zEiE2dR?xPHr@lM3LUH!AP-;j>m zVBwp~#%4?kcRsr|0a@HA-K91sB@LEobKT4q1zE`P$g1F7TF7cG1s-{&z`zEmaD19A zFYrtihAb4w-7DPR^axNjtOvfA#Pj>#8A3H1rF-mPzfZ(J1)K!pIMMFKgaT{gBT z)KJVw;zc22zn-8XaAq$Zcb&wRct3y`s>ege19^|O<@{%wQFuE?*Maz6o2t5l@;g(W=oL-t`D)9Y;PrlGjP@W~9O z<`ybO?N4MYPXAV#yyjL`&SHUQhA>YPh|vDT z&t?12apt+~n#Y)W&Z_&S#m2oC!KC=H|F6$9HM8k zoQNLTLTR6M(|>&LqybG_~U1q%|eE5tpK< zl2O4i2<5mW_9h@S>To>#s0LXm(s3_W7l@Nqnx}pvm^jBx_)W5l!5`qS>-@uFdkpf% ziD(Moj^6v=4~sQAvHyAYa#Oek40FlEu7tZuW&@IN9;+K&I*<*Mr%^y|#x;XSdhZheMoMA;KLs1-xK|2OxSY-=9Pjr37-1*qD_ct zAX7j%++1Khbg13-L`Tk1(>ZFBff;80zHl_atNq~B?V}d9AIIWH<@ANGSG^6-P){1} zkXCN6Jkm=XvD| z91tHAm*O!-g!VxcZJxT?dggzWy?Nq^#$54&4ZTV$sk4uiudIPu<3_tOL6skTp~Aps z&c2_tni6edNG7<*RK^5o=774mdh3&~-+6DaiG#<=7t;30m;dOuRT~l{`~KwUqD<<- zKW{MP-R_(+8oe?T8~pid@vhYwCto%Uyb7(MD*X~3HA>ZIJ&Pt;x@Fit?S}Ha~^9Zee1~)wq#QE z7!#%nq9Mx37i+6B=%aoeGG=O~wgge>J6=GQt7sbY{%4b5+F;%EM_j-(Ba==x?vSty zYlVTiOvg!Y)u+@N#bchyFQnt#D)!8W;BB}-Ss>RP&YDkKH=^T1HH12PJUCp?ebW41 z5UxBmtN)TB`0ium4T`D?-eA>0bw=_<3bF_;8UG!9b2U3#)YumbF4R;uc9<2{v}^LV zvAi}lmBh|nN(;R@>#rp+c$x7cRhYM0Ah-Vzp;T^!*rzQpNEe3Gr{2{%@N7Ly-v%20 zS~6URO?rovnMc#oLo%ZPnA;cc$7i^ZlvF%et6-eouc`C*G z=d0yzt1K@W#9kn~Q;wr(Ph6@?Ed+Ql82elqMQTHUDJ>2BMazIOH%|4fs%r;T_8=eq zQ7t3RK9K3J4_RDJ9^a$#Y0J1ST+Z7-AV)qG4<}v_rkNPof+l0cBZCsxxqx%q39bya zk%{=WVy9oj`LGu$aakR!bJ?%2(FNyvZG;!#I{liCdz3w12*jx%jeKViVIY0J^*mK6 z-i&MkrT&l-=RIf?;$24w{{RI@s-3nIBO7Th(Y@xXiiQUkw z@wg~wI*8!zf}pm-hAKBw&;^QW>zVQOs>onapL)*8ywN&YnAUA%t1xHzDekB?RY!`Z zzjEIAi-!oP`Nnb+pXKEQlJ!U&=z`eMpEkNfGwT==&A4?(2q;}@S>zh3 z-be1iUwe4!_xtw--dIBOT~63_&6+f=nHNXOU)2`)Xt?DrG0u#ksz{b89!KqKh$k+; zHkD*!^h6Z#xX3O>z-z>}K=1rIToa9Kl~e<5zCWAd6~bxEbhOgPW=?(&r9^H`=!G7O zP`p0B(BMNYzZgf~xKxQ;2Q#&C!Ibj|jlMZ|;F1?}yjAOn-hD$B>bH_a(m-DS5XGpD z_*CcTN1O!5+ZfJrcxJkFgs{P7z9gDuc`ZP22HmCMHGd6K5KCN%j(=r&p&VZXZvA?V z3n;gt8P{8#l#Rr0w49D|EI;hk-x@VG|80T z%dY>QFY}GRvAha@x{HJ2xwo2{fQ$%JDQ=)`4y^OL7U`BK&-v8flUE?KGi!N(E{fY| ztqXGEa_aaFOmF9ubMT45h=KvA?&OP~Gbje9SWDH?wV_9ANKmLly$K9;05wf;CY@k8 zX_IC3==)`d7V(wO*TLHuj7*9NHS5xsh(+d#d2E#)N0p&}#OC0UgLyf__7s#6C>)OPM?? zOnXS`+2Dfp)}efm5y<)XwcQPes*LdH>$&W=O0>HUkhu~bEjq~0i`p}5;Yg%om2@a& zxy-?ccfS~}&A7MyZFhk#_=CwyY@=18GQ+ovI1lm(y$N`)c}JDJ*5uV zH(oy~+0&m!EfoZwt)?qhbsMb2lVz(70wIg&2C~V8Anzcz(Prh4V4V!k)&>RRcl;oz88KX29$L=G)<&C>3No!3vo8HA z`&zm_wc9mj=v_3HX^09fsmnZ!;X>XiR%?lxL&>$b9Y3Z|<(MUEF~UD@p=G8m)dpMJ{KeItDJ*Hwt5w4YF}kp-s+&ZmXc7MbVK2T6Yf0H?2Sff9n3YoWp9+DlWta)h^lc2!3kX)DM0fTIewEOJ-wpEL=Wf-ZW2dES~=Iub<3t zcg@et0O&k?U`^Q1PpvfNj&)g>M2D3(1^&8JTbaSP3bLU#gUJEp@di9uu?Z((8A0jk z%#FeZ!DnA~%nWEZBD3&0)#^3>qx#zlzf$Fv%8TVbys-R z&Z;LX=>}CMj0f(BD^vSCM7bK)03$-jn6K`@G$v6a-}C>M%XXmSwp~@d~a}N6xbA@43O$bi3PwnIGJQc7%WM--lk>oUEjp_ zLrM4`)fN(+k8-V|UYbS~_%pgMz$AbADna0T>=b-9-7}%yLK@+JKS`END(Fnh@11$u zr!bOKSjqkil_W~*J!)l3=uxI=t=-ahr;_QwpZ3%P6W>?QJb;9E+|gbu>{c)>RT*Kh z8&TAg5x6v%t}yC4>Msk*-YZ+-Xf3i5dBI zJw?g$dCy6B_9h#5XCb5tapBSnb>A6e5niGT|r^VFALE@YlZ z&Sbjbc7Q-ec=8g=n19*)x3?Iub2=2&&$WbzZhDvDkz(X*p}HH4_;7ASreB>CKxqgE z11cim-zYSwycSfJNaj zg_ZDRxgBByd>?-TXn3Axg>2`se341*?{a0aM~C#pXegNg&ynv+@pFdzDontev?==! zZKfzysHi6Ny!eR$BQ!`9RH@jfm*Lor2h3{{chYe>5Jk2?Lkq4bZPM?>7H75&gUJ6y z$0!$cV4UH37ahEI9*@oQo9JNt2lT*D~gJ<{nA1AIlh z8};SQT_R~MvX;Y+*7K=lssi#`}_=AVtMyM)xUv`n@w$&5K z&3U>MsV%zV;Mm+F5HthgnhX0yDSsEEO-HKuuMF)b`};s)RMn_CP(!c;r?Y?W!P>zo z;$$Tc0J1)px#`$JF(Ci=e48_9t(mD1h^YA(+vlcpnmV9rH`;&N-I=OF%acSx{Z!3Rzqsj#&#Z(j}n9z`+EI z%fQfUh&L9D1eaWxTU=OO0T2B=X0yAv3N6B;n-L4n?4_M!DGxXW=u!6DV>7{(rVH`c z4R9UDDt%Y9l4>4;C3ji>kiw%^R2!h+6UE3>ye4qOPpP_XDOGZ@HpLkkxIKr$fWx5S zZKPxV28hLxGUc~bZ=AH*I~4yP5=toW;zVFXJP}z0y8+@#;J9ICOFg+|uBa$MRp2h| zuxAG@3g|%+4UcxH!wp*U(4n5~$SPb%fd@z4jK&Rb(V?cAnN!<-t5*gGp{rNfopZ$R zw#S;D6)H0tgr$hx!>ph1-E+eDR1uE6cBGel(u z741m~7}ce8I}(>h93U>u?x^2rxb6M6*`5uXy@TMQx?1qIudg%zWh-oP3+@%5WGacd zQ=6hn87^uHP~?um^Z#`1M9$1qibcCuBB{%AZWahxR9&H*w>$?2s)cI+)PEbN*)rp5 z*eWKI98{$S90Sg^ffc0KLRFxkmIW8H!6h-$NfzV5gvx%6@4)H*jx!BdvW-i*1V_~c zYkHdH8wEHLIl+_>ubg4!N%7Er4+SG4abee{9EECyYpFXD<=^02abr0h))oRA;0Ylg zrmBG{xLBAOr6dpY&>qk!>_o)gK$?j@Z}4A%_f&&*3aiu}`vzQDZ=whp$QT<51ZD}9 z^Sp@>$V~r@#54hU@(uUmXVofK#Mx= CA_}Mg literal 44788 zcmZr(30O_(|36I>BgGgBrL2)Cdqg$EP@+uCpwP`aO(>+I(#=xVgpi@dC`~`o#iWS3 zB-y2?kTzS}I)e1ILXVNPm>PqRl<FGJrd9BNaWlnA@M!K$Fb-Z$NACA-Gtfu`m&+9~azE$ws`o)Dc zg{k8P_TGQ@h`~|up?S|bT-A1~o2O@zC*3i4!n~dbMUs5m`n_v<_dTB8cg>xq0n2us ze=_C5UhVp>T`E-jaKloQ5)wXZWX~{m)R~@QY_$!l5z; zZpizYE)`Yh;^LauHg?0xxc3X3oab3N*sFFq?*rRQR7BU-Ml(>4!IQ5M~> z`8UVx(&fu#=9850gz<#o4h{~jo>~D3^o(cWu`#P!mNs^J>#}OqyNbAk)`RrSl6?E7 zJGI^E6;IA**}EJ+emphPzG+@VFY&OZF7wYVdNxz{y3fmvxr_H#RaUmlaj96}*h}2m z`^DS0ZwoDT=|vV@hubzL%$sa+WS-AYb~W5O{K0?sAM{X8#;=-DC0!2gR^91cW2|O= z*z7x862GZ`tyzxSHrds5v`SZgz3)}S@3CI=RM4Mq3{v%bY6K7N=@^WsPt2Q4KhLQ9 z*MG4=zsN5912^#yesvo(-~0MV+^o;v94_3v?y0};{{Ku!`}sIkk6179$P7Q^V_ZI?B@Q{7cEnO%}qvABXhR=r*vY23{?7 zTI4BmjZ0Xk?f5jRMCqWg$V0nTaj{6c)HWXl8mYR@e0p@^@q zACyg{b(CftXd9YtSmIMt@(Vw5xZ7+0Yvb@Hb<1?kK^SC5q9v1$>UVEPw;z@#sMn2r z6_Ny+CXL1a`bXS@bt2b_GqDXh&r?sli|8!%&mSN3YFpXBP$S$tk{{E!(BJpbnd9Kr zeUqR<2p$QVAf=yl^P)?XK1P+ekihe@5SsMMRnbwb^bq4YNiZ#^$E9FiMuX@1%*Iaw z0ef7Mkeov@QikB2yx@p;*}v{0%$JCBMUOGZ_@^#9c@8cWukRd+{}V%udS$Yu@cHxS z=2nH*eJY|$3XjS~XviPM%1zHMu1dwD!Q+BnHQUvE&fn5h;VEa3c-O)Pxfo&rrCXU+ zNVjX>J6>TQ?1LfH}$N{Po*_l@nQ(YBF%}E-2VS&wj;eAcS%yxCq(ZjvWr@l z%BRPKuy;UlAn9J#aj*_|yx*l>9)}4=S*7QWJ^sKf8w7`T)1~isGc|;U6|~-+pYqWt zx{B8&{_^f!8s%|Q4(x8#EHmYXlwUf&_DY$5ZTI^}F*=MO8=-6|8I42wwkcPL2$t!& zkXJ$3=2%Yne+c@E`X4rAE1TY(oMjK6kuY z8c8Lz?56J?Uh>wLZ4s=`qa(ZHXUL_=digMwx*X6ntDUqg7+^hyO%c44(^WF)$jWv` zOpqQ?XTzuepZHjd%G%_o&aNiHx=_j339H3_VGdXPuO-BvF3DK;^&R8#v*E*sYn+Bn z#hpg3yoA!7Iu3VnXU^J`FK=_lLX)Ga4zm>q#Ee{K%@dQPEa=tCxP-#l^qRtt`hFkv zU2T|Sm1d8qkZYv9gG2IUwX`teoYxw3y{mF@EqE6-nP*u_h!$_xrS$|p=D_jEB_ML(3PzZ#>$Iz2 z%^*&CxQN9@_E^EQgC;>B}DQ>DP7+ZFxw0FDjU0r8n(-4zI*P3%|%;{_pwo>sDxI%qJde@e6u2ZkNLKl$4fd z(8*xPBPijvcgX)Ep>DJAYhvBgc|I-`?|3}IkQCq%p5Zc<*?|yoVUss~JjV~E0F9)h zLi3sPhATP*0_7(zy6ROkq71;8;|z}H%LRx``VCuNYz!X`QV^TQ#>Q0{>wG*L)y16! z&5XRGE&#M~i<8`n!{tkm=pBOF!EG|c0a!vle1X_X5UC>XRTrP#BY2AWuhR#XYVfUp z>1oZ7ta#=SCXw#NX@a(2D?Q?{cGHH&P8ft;RRjVuUpGUgPOvxx7zOWf{{ZhpWe}5} zduR{krbA>#tavmaSfh!?67%$j4A=texySmL-1I%#d0ZjjQCQI#S9abIJJE|7J!MLwaR0lflKwJN%n>_S^LOfVob_x+xHm5W$bs|IE`WeuXGv+lF@!n-5}sPc9mP z4v%x52b*pGLQs~Mz6N`hx{379J^{ta^XJcZ3{Tni1+x$s_{r3bw4m!UYdD1gzgHXR@Fl#+~udrK7uB9Tgx4kD^6CsFi1| zHtOj&NrAIGc|ul+G+@NQA_~g{$ZFxNQrGQUi4$k3mG}P-wN~`b+a^rqd0t-9g$oxx z?v@+OkmVu`V%Wjm@y<|$4RRWplAj;g1n3Ii!OgWKcuH4 zIX@mnitW_O!}6XzyL<*>GRXI+A{Mg%(QN)BULj7Rs-1XVFiwKOo@p%coX#XjAxMqv zpzOU0YXQd4HnEkQUHY znEzO{a_i+TE+39k)R%RUWYIdk@EP8H5PzT-(ISzf8OXDcw}N;#Whbn!OH-ErXM$H& zi5!3a4=GFk^7q~JpC!6OH=}3-xKP4&!=WV7Y_K_!2Tm_Yn9EAf2CbCZX-ozzjWG8a7o&s}*FeGwNt^60zl0@KN zz^|sb1kckzgS^AjyDME1@}Fhz^}mM8AgrRf`%&4OaG>DZ1g>^hsRJ3l(T^b5*YD)3 zzTG#Vcps(o3att$?3)$n?>j(#d8g_53m0J7a7DYXa?>;geXakFd77dmtvr1uat2n|Wk?VroFe3HGE$|kY||Pti;Xt14V!^Vs^ox0dfr%KyZ770 zN^kVe(UNP2ZRc$kXel>s7bpx|D>xa$-Tpcl z?rhbG2P-`(B+ALn_4CutP$0gjzgl?@*xbw=8e{~DZ|tZi;LKwvQKecrPYO!n2!q}~ z?jL53C)!WTc)p5$c11Xcy%BHp#0nUc=<~t>F-@bi_{f1)_Pz?|JUrxs=hq9X^3*-4e;4 zBC5nh+(xK)sQ&`Gx@rYzAbCQW%KEMMjvBc}vGh*ka?!g?IqM1e?cluiHUFt-NEY4<0;lToX5iCF;Y+simdO zHc0sqi{Ld@Dt-9()pNuwa2TQPW`4?8m#9Ro+;IE1dT;Ec;?YaN;q#+}j#M_?Lr!;) z5I^3j~@N?xQ8Dk(5GE~_V8BPv9N*<6{{Ho&d zx5BKLJc+lel|z(d;*_~#!s@kaTbh|7NWW_3mF)okWXa*-allGg!_b>j8v=oC>q}v3 z@x)0K(-)8tF&5P_6fA&vfLeL&+s~x_h_d7<<)JsEHuDt*;-~bTTDd#2Y%<5dXS}5c z$4Ih=L+bPpdXZfdX$2(9(UIXqWz)ric$9tp@~KLm1e4svczpVZIU3n`qb1o14r?#J z*+|n`shx2Y`OAgva*anq{KL+@^lNSQBgw4)shx0l?wwZ#g_3CzZ|cN@mx)#lgAr;a z!xRe?Cl8K}?DY?emK@!kdJ*&<1od?X`mEPTtFEGDjK_ls;kA z>bNT5_=#uY@%uZzy<5_ghk%&I+qcNqGBtkVO!aG}$!} z-Kezgg)0>{@FYxWkXGKXsl4n&npP&gBF9MRiQ_UmE1O1>S4DE*LIVD))nPet-c-6n z5{KbFWYxDI7b#B!l#2bs*8gX6+k58?;}eex(%fl`WG;o|?VxP8<)Rovxy2U}N&Qtk zWsEK%_of~tfptHATkWTo(HyLyhvbo?sNN)EtG%G%{|K5vS_y{H41wkz_s%Oekc%HiB`F^` zT9Wn~UMKRh?T;K#ov?T^D z6>?~)euux*-gXpq!)VG>jyF?Fo66sQbqC6OUYYkF^9aO#5uxVaO zOf;vvKR;l?=C(}5!$cupBq-YiktlE~C04x45bl+=<88j!Uq_u322idZhEQH~&UM05 zg7nGLF>YP)3PeZk5nNFpP^kmvKnQM)tE*pRLY=EThqP#izfO=4>JVUm8SnE(j@YYz zRPhLvWv3pVnD{A>hsi{&@EcO~4Q|XPR905*=hOQN7@){Xt=w2&V@hpi4C;pP?g|F9 ze3T?jTQ27yDTR98cz|+zGOX$QDK4>~F^Gvy@JdnOL`axSc3rhIbPtojiQa>i3JKPm zOgN1r754-XmxKx_M!`TyTyL9#?qr65Ccko>_wUw219o>#@JbhcLovmtR$hVmyi@sMY??$z71X+~* z=Iza!-g*5oXAFdJmj^Tr4toM4ik5fRSWN?EVUCmB z$L#t;DhXr|#PTMAftSG?tihwO|LC;g2;IFWmk|vCUdOacZXE$3Cy`s&LFvLa;~=#g zEtyJLzxI&DIwNrDg70V`ff;eAFIJ=9!F9GSH5@gq5CskfjoVCYxM#`DUCG%L7)ZCk zl3K~#3GN}NeI!8RreqrODXmlqn5PKUq*=z2v>%WId_=T9sMz&n*iqTku(#Yw@rKZ% z-bX87Fp;sHxV;>MVL%k%F1~TM>xGi&dvIxSeLuu^6a zGDqOGqXg2o1*aBAF~;kDn@dmH?thhZEQK``DcGr(HT|`|_bNZ1Q9v>CQbbadHoU#B zdnu>jFaBOgd1;Wp&i63kY>uS(LKg-oPKMD!L#=!cC8^qFr}Z8NIt~@I-}MDj|Gy~)2x1cqMf5~%fC^x!4YXvM1hrCX zpHz(Fx{Zs{;CfNv$=^wfC3l~i1f@2gcsKdo;J$tPCYL#cMgYRQ_RFXl6PFNgUHF~x zugPega`*LZPRt6#@{Fe}kxX?GD2)ikT)y&~P)^AVUEf;kxP+&Kga#^Fk?ud#7%P3t zA-D3YqQK4+@G2rt@iKrP_N!ukO}uPyca0tjG~}&Q#;q#FT9BC z>TE%elHL`#XV0!;J$e?tnA1;a8XOpxz>1sYo+-tBQ;J_im$>kdiF{2lO%Wy}t1nA* zCqnVY9DmUAhjvC{R9pVE*F&j#4NrzsN=scw{~L<@DD;@9%^ zjI6#q{FRBBAqkRna&LCs?5cxe9PxJMfPP*I1x4N{-ruKLE>*}9^7u})R*nBvX1{sL zZ*UT+rrgTO$#MNRr{64=j@8bnIk0bESM!*j7tWtQ50BK87MEZYjk@apoV1o)q`ppA zM;OI?pQMiALe?d6%&Lc9YfOS%q=0ol6qH`tyqsd>o2 ziJ^wFsl*7qq^YCS(v%gE=v8|{hT`Ur{=M=Njr_jcGcUjx2LXndAxTs;Bzf?D5(-Rd zmVbDAH>Kh4zv2(amGAM_F(DBal5@P#ly?1M+(nzpjqTE9`N6oEa`o*(S?R{EWy<0= zs4jSTXlKBcAVT&Wx#ViYL0jMVa~-X8Z+!K6Jy3U3!R!eyYcJJ8e9kTf4L*)9^7FsOmrV_g0AM{F-`W`8x-aLs zbrwn-dA>-d#m`1VF6@!(>bPsBz8O#VzJe=ubD-LG(R(!~X}(~RDS^G(jQ+#4>H<^3OqPiflWq_q-UK&$V7?i%;Q+Hvt0%s#>;u35z1 zGSTb0`nNa8T3sL;pnRw)C@=5TBoBsY=H~(Z7K9>GaxpGpJ~jJD{JhcUhm1r#1!*>r2Mv;cC?C`*-f-%7c8RB(9^UBM&uYvmv&qd%>b<8#JaTmV?epKs z;f{rlT+wtGvRImve$NQ9uTZV+Y^i+@>{NYA_6S-%x={JAa3Uf5GcgM^XhqoB^Lk+cJE8Vb4*C#M#V_-InJvafw_9OK= z*!F}S-ohELRq?>=STRNRK31^UdwkmD%&t5QI|G*xk(kWfy3@rYQeT)MTY22)=Et7g zUSx0iA#GGVBKzWo#a>3J?5QY!Cv;4xZGry#lnsU=;8JH0O zCyo&ck|sg7YD=e(LI9>JvRk|k?%^c{BVflaq`WJCb}_Y&Z-=za?_*JotR%)4NBh0~6^EBTy)%bg(8+Km;{o%S2so0uS z$T(0R3Tk$w9ygxapW(^D1;g+x&|(Z&U|^<8R86!>e+MJMaTBd>DtDpy@EaWxFQV}d zD2xXQ!lXHlOz93ho4I5E*|TST9BaF)QDR&s(ZPGBO_oUhACbF#9ZGosl#_|vqPT>I z;XWVlRP8m}?xYh{(rQZrFTF$K<4rU^64QRd`1xzFgX4=O{`EnxXKFv%5#Tl&w*Q91 z;>EsKb2bly-B%EQ##c!mEn-RB=c7~}M9;u>_>R;?GcTJ9H!}h5bsXgJBJw~vOV2nq zzjvj|6qJtV^U^~*RkOf7(#>|lF>2Fw^(ab&L95!y>eA5?WoK{;sWtvW;^NEe-^?e$ zCq7F;A&2hmNfZl#d1iOlXc|@7wSzRvEhyPuT(JJrg9)i)1cAYOVqd;|>51vV^Jzg- zsY>k?mk=0T@(Btc%#h;@d+qYl8^NnjJ7w*)4I|sr$Z~U%OWA&oLkOqrOzb(d`w``n ziJ^emE;QpzbBs6T{~53GZAa7Kf}adp;$cp;MhT(^;bNkqgCWbvzhBC!Bnfx2chNnt z`;koCX!PiiJ+KuVmpi1p#@+zA$dkchWB7jDs-xB3?mS|xx|5cRRHsww8E()%dEkW^VepYRlVI52xwga5HPTu2E?;V#KwCkdLi@yDDj&Pjp2gjAYhj{PAWF zmx_yQttuX(`~nB!|Gzl}a!rr=Gp=eVQM()BlD+5-wg6B#LASlEE7@bzV$W*=oR$dF zB)2Z;T+N?xA9&BjSxihRrjRobMT5uux}*W!W%g~#L7jw zc%Z|dao4_}7MA*>uPPZD5;5lRZUSd$Q#5@;!E3@aaokd^Jf(9GDH;8}5^_G5xi_AA z>`6YD<3i1qO{K$W?1Q|dEgBI$ix*%{`~|9Wl|pFL2HW|c`$sXOJ_<@>Yhb3&hSSAx zpB07!Rd}netKuR4KvR_Y1%61p1ar?PG70vz1Okf<5?hi(J|2Vb;q=B}$TMWx;lQ(z z?>&0Y{A*B0y?}W>OR5ZsZf>ZcaPcMooA-4I;P=2G@DB4+8=vY^$)D^D=E)VgBZyOX zLMz6ngx{e%g5wbM3vOXQRuqiJA;Kw6Q6(D$@?w(($DQ~NQ|OOXwb>AvIYPNuS=+z; z&ix zgT(j*D#9EXIa6>JX>hdK1i{YcJU{N(^gOpf2U210=-B#!_-$oi7Vmk)uEmpLElDXT zltGvyKBv(sw!ueW9q63$y9;H6#XT^u6AEl#PS$-=a~QKn`cOs_GOMte6F~?74qi)b zkl%MBKVKuK8DtkU+v~3*q6{+`w<`ucTm4Q!3CSp(&MvEZVjr=aB8FZlxrnGu6o_iW zB+K+vW&+Mcha8*dV-}a-$Xv18a>$PVeVDEsd&Y4Ye>~w-sXvZ$n~Xb@X2)b3kz3|b z6m_)lJ_98eB^3(5teKR`Va#JF2fM(FFJ0&i-)9tJXAeQ*B%MID7)mw^x=lXmk4a%$ z&gC>R(G+#Z05*c3KcS8useK6CZVJd(OdL8v%^^@ajreotS}baH)Lcd%n@nzMCi6z< zv_jQOI_xi-7{{T}tKo2rm)?VbHY^8+hy{$6S0~|~vgA}OZrYW_0&0+9v3*#b%`wP< z%s}zzlH<@Rt;)&}v@E&sa$J%bhWm=aWX@lvq;BY05L1)!P8b#vtt5x~y1IV5%(gn= zc}|*uSG`q$v^DlF@JL@~#biG^Y!}WLx*38JYEFWZ7=g5Ic=wtCb^(Rn_br zQ0LMc@s>=K1=GZFUc;14EvWn;Ot?)sTOcKR51XSyQum_A3iOp3Bc`3`YqAL4Ht*|V z1@|C$R8H&%^9;iww|{X72?*|%$?PBWx0X1J22O@n|8!Yn&@+N1mrsFyogg-pS0o!E zz;;fW2Qt7$%g5w(f-^={R=h=^>mNw?#k<6%Y9n>HQ&4{CPw|auO;$irKomLprZV2+FvqmQjd)Y%4%gHe$b`3qctiZbiBX3d)BEiM&v3Ft_z zAXdF7m=ydhiSx#6c#(W6IoWyVGF4@7X6z*~qB>ZW6u!xM0V zs5^A$pn$70(Mwh+@Xv}&ljILPeFsl}>!H~NvVLtMBZ#fU5>HsYq*OM!`~z!Kzq~zO zB}m%#GjR#}=FMfcspA{FQFzEn{|4U%B_JnDU>5z*XrUt4Q@r-s%a_f65UM2kNytg; zN!o^1998u&Yn&*+p9^3~iR%3Iai1?9y7PJ*Vp45V(X;U7W5R5xqmvUC(E14G)StHh zFhwCpLhH*kg%Yhtfx)z?sYz2oy<|qoq6*6yC_$rJ24;1VCmNI7?6O*onZst{9thl>8q_NQaeF9oTC-W-IS?s4*3mE_8 z;lqbho#S3=l7>9B|8Pn0(6ul>#-lMc_zaE3*hv;Kqwu-}*_+b}R-0pY{fu&u-=djc zmNQU)H8r)hcWlEVx!`cz6sXGHCm%n4Y*u&}+IonPQzRO4#Rtfi!HH!fee-WZU4%kF z#Fdh&z=<$}KF?(hwh1q0A|Oawq$&-dkV}BVM3DsVghSAp2xf-IH=3Xgfv3b0T!JaEk~Nd>adVf=m@%Q5ael3%o^RhqSApdVj1~ z@y2!Lu&N*hfK>D^1TKjzB&~1ku~|sK$V8W87rlNX7329LU=ogtL0^mXq}&S-I%6@$ ziC&;iAkkaFhG8RR&FALk=0ujGQz1HJ0!+6iqUHH~(lRqiSYfs!5^gx>%Mz8(_8ZBK4mp(*}7}V0uXhPJaIUIX=X$pa-l} z)l*e0RV2tES0sTdocIeUGTrX3K3SIYZ|v@(=V1dBr41}-2SA=TPcee@*ZCgHn!z4jgp4z`?X=#~>@hOW9f^Pu=!5JKg*^D)b`GSh% z+P~ObvP=IV+17BsmM@;n8J#0VWG&`GHYtC^s)r{w4HE3P^fRO{w69z&1s}?B=Kv<9 zi%1f@mkoRKQt(M_Ygi9Ly@mWnc0qBKGMH^hehHE$(tJULWM~BcL}ng@?++FTeyf|z zSft=p7M(B$nFdrIxwz_4TR2?g0D5g#a6wmdow&qk+pxlX= zfhMmxZGjV^F@17*qJL>v5);pJmgzCH1YttrbxSHJ~G=W^#ZF)sX_A_ zE6!gKA~n(=GKHjN#_IGk1y>~F{%atdNEf_<;sS-3ko!V(p~Sg>Gi4(MBeN^sL19zn zzUUvVYL+X!B^dc6b}e%U3M8`ZX=b*qdGkKIyMK}cvP6rQ^u{+7g-%mmjC;KdCPmRD z2ndGzg7q#SLda&B-!Tw_ zRF#*1&9%F$F^$YrRm6jp8Z%%|kj|JnY{hVj)x14iU8^Een=4%XMgli}x|DdW!t_!2 zl;kBYpQrTVMAyG;Qy1?TcWl;LjKbK z;A2QFW<}9Z6T_=y@pAssu;tc0JZxt+TvinU+$}}2NBkqsB{{81$^9r@=t3DhG*l6( zr4%s1vKWQ28N=SB(~{vRP9kKg0wyJchm>}AsEac)JVpsQX5EG0Dj_vB)gD4JfH-WS zk10fvB^4kM&Kz|CFe;~(Tzx6+zqXm05cJ=PFinqo;ss6NN8)HC z!5@*&V%;jCNNsYb+@Q&yguse9IwYcz$|FaIoQn^6xgDTZ7-3yB;Mr&zE%CX4)lJ)+ zhAsbQ{b-NtUSL}BV?jG;{3LYQ(9@WvmZF(q%c7L4F{RezNjs!0Hy~9al2t-@$BTv9 zppiuUs{$-!+j~qFV?EPlB*S*K)&Y&`td7Q-b8L{X5kLOx!AeJi=!WVJ-QMMAWo5xb zewv6=G?*K!&A}!lKR{wW-WEN9#WG*Ob6ejX8~9eC{dMV6`$YW2iO_S-u_QYf5CSBEx8vrM^S>dtULYurKv0(6 zQy7wI?Fo9(Iay|xX9Dum%P}dpt`y-}TU%36No*b($wNrmFFk^KyQfD_4aFR7+%TNGYojULfH-ld+Rm{Z;5^|DZDfyUo z3iMh!N~~-KoqC;s7ASRq94Kb~fd=VJgEXDYdCschxEoFb z*IZ~-bnWJu1Z*YYYqo4Gw2pHuE8cFb`9Nh-iU)7B#eiK7 zZW~&Dd`@d|+<>qV(fOLb9b!sOmMU|%%7KpJ$-9Xyu>!5U>u2sn?4%cYSPvtg7VBjU zr*{`{fa8{t3Mrx4*!gk@6-8aBmUhPeLp-cCX1C1=S@**wx_R8@>P9$>$-PLWr;*f% zmv|NL2%I_0yc-$xW-FJ9Q$Ubsv8%EWu4xdO08%O*q84@N@eFizP-LsNeDtxau{oQm z_B`;C!_3Re#vi|?g`&E>z5R28=-b_uYu_Myfn+ASz&YjM0BBrbRPm<+_zRotDMZ|2 zCCfCh@z8+&;SYc6)AAUWHEAS0G#vdNI8!BkkCUSf(O6 zgt2;Qa&(Akbn&N!AizjWU=JyT7zZD4ZXNK?#lZo#rFvakU%~miF;5yr>>3Elbkgq{ z5sU><$jU__0o`@_Y>8Y_;;t*WT-9YF41 z>o2D50vV3tc#`OZx9`3WX4&^Lc$lK!h~$U(WsW5Ywj}YJpw|_lxHBTMVkIgLbK-gQ zB4xa&m?yIqRG;I}_N*-3s4&F8YzU%bE)B6m;IUR*ZdFy4Ig_vxz%j6*m{b0k=#Uvy z&Bw5>a_p1Yi+%w*6(5CM2xQ=3n2~~{kUeR)oXtfjcyU}8MEbDb@|)+o#JwDa5~Kk& zs+g!lHnimw<#My^n`YCzsd&ZFX!`tWiYBp_kWLMaE(chgi7|H$Vtn9e>oszv6tQhq zb#Cxx87ZDNCTeUn*i`Yahak#Zd12FLRfsO2r1T$1mq1_fDKbhTG;%6wjerEXWmR{^ zRX1(ovmwQ`ry$}ovXiC5M7J^@E?=NNQb?E#=x#iTxZ$yTtPlM~4JMt>L~4};8kB_!(I(t6+fYgO<~RljWB)siD~l-7ugpa$r7X=I>B{k4-jMu!2=~$Y40#8 z3v`NNeE>mvgXMJXhQuu=cB26V0fGAD*hd&*!X3zU=s`KeL=YMV_0->8;vk`_+$q|f zV}WhETr8c4nFR5kc93a^_#u1=*9{3#i#|v%)a5*X$*}uFU?iQa>dUw@b0E#-Z^D=) z;y^to0hi48!`y<`nXGHGK^DYP#Z(8UGGy9ZeCNyz!1aZiWOKR3&ISYc1! zE}S+qyPwvNR}7M{fDQ)(9$A6@9Y4p-`>I1dSjkl>O%Xn?`W7~%+n>o;%2{asS*ygk zX`}OWKRQxa;WT_$bbjUM%_ETjPOPk`Xm+mItRwFDn@e*UFpDmwVL-23>tR)JR$Szd zyS%twWa0z?xeebOSC5jn0gM)HY2ge*DQrU%2#6+|(V!)%iHY?e$P*!+d64sbadb#C zf)bAI4?#nZ#!CSDcp;OTXg3cL0NkR`4@os{XuV zIe8|ly0AA$qXuMyt{+bC1YKozOk-x+yMd52WGks8!A*ezO1cs4r_7!C#fw@>K(p6E z4&iTTO{szcXeq}wkYyAbLmICPkt;be`Yh|kyg6MU2iM=(i<|!T9VO}~35g!^%9#o_ z!+1JXnorP>BsQ5O_A(8%^iAY5_slUbe*Wy)CMLp-b_W7%XJD2{khA1B?LOjOE?l^9 z(}rPhj?3>VvQlZ{WWW+sKV09^Esu?-<~WfSC&T@ehK)S53`a`(}_ zEnX}43fvO3G!Q|Ho)BTS3RWDIa~Fta_4fizKS6;by9nmwc|k!+LQbP4@C1~GCsH;n z82ovg*c3grN{^uu&xt-*2}B$j7v5y!%m|;K=SP>+1M+Ymv4UR3U9b0q-fMAU%Ln*e)AAhI!>iO-#1`92n*VP zab)tK6~uRENeMjO-zU((-ese!tLyJrxX4(jWKSi}povx1L=|r!3P*>Kk>^ld3h zxe<*|KK#umR#|D%6orN6Ceb~& z7kj?kc!+LP<(;Z{NA(p=N1qyibJi$Ejo-MoL=}0>XvPggC8+EuOs@r4`&0x1qQhdOK@mD^4;;xbb z9SC3~fY*^DM$E<(I72koGJEI>DgeDlDG*p57dVA>!aNa!7o z2z#)yb-Z8|eaOyCMQ??-^{_WO<=f%yuWcN;+;*)FY7Sn34m3Ik}DE?vr@l`Q8gZrol5b%C=AT0Sxm4=Gc~;8uIZdA^J~r+h6Kg)waE0Ff0Xn z552b5*}06lG~}`@QYAvV}Fz>?NWeZE_p-2C*~>BurY6Yd|AWnlj}|m>Ic6%9)5?1Z>NB z!PpT?MI9h*sErn*TZXsAZe8O|v563nk=0^YS~`XF@CeT=>F0lQTEgJ65Hx2{XiE)! z92O72(>WpMJu+o0$@nCx;|;7)K@WQyrMK~N_n#njQ0vb*&-YWuulsDiHS0DN0MqCl z2ZeVa1Iv=)o8W+^m+N))p))by=dRZu<62_euYPrvBX56fI`^rmYQ&k4X|i5` z!afiFC=YpKV0yUh&dT9K?tJIq;C3MJe-{0Ey~r0yHIJ{bx^Q9e*zA`V#@0O-E8Vg9 zBnj^L;zl2rCmIL4-+6oI^1`$W6GCGKi4M)H`0WQZtJMZ~eqZxH?#|60Hfw!0*Zg+`#axhDvhLybTrLuc&!0{2ir zr{gQQ_fX>d1g(HAe}ZC3ov}}~_SS@ynv*C6a4TTSR!-+Nxg)BP*K9#qlfgKIs^6A| zVsjkcAttNx30Nn1a9797W!N?ye<^3ncwi-CUw$jCg$}Chy-9Ws1sIXiE*Oh*U?^pv ziVaXWrJgg<0U>8;pDy-`#iR#WrD>9nG4#i#R$H?#uQ#L_=f5CX!8U5{Q%${tOY8K; zPU7CO;d=2WdWsrxc?{rJH~p@T1pX!1Vm?mibV+L>DHa;sm39k37hCD~w8=Phcj^-w z`XHYDjF&GLUVavcfOfD@8X8?Kw9_MoT;Zrve@$6gfsM?Ok;72Mo<&%d}%Awv)ZPwXQZopNqt~ z4C3!_K3MC^b=tagNXN2Ai8)cld+6THw1abxQA)!c1YhE{(3K%Jm;=rp*pEo4kvkiD z?b@}bXe{I*zaNwHg#n*MkPON^JJ7iyf{wRy>yqM$76x;CCxVvAd|3~gmcU2jadf5{ z?dN25&{^bK!|^0Rbv9V*6PP^brVID+V>BQL)cmNz@ ziZPd_uH%_sBVtnrm4>WDTTjyx>*&DfOJ%f-*HbPJsT%$dH+M>XVLgI7sg)AT`AVaD@HC#a`S@? zVD5*=FB-Skgli_h2l6`;X>fA#EF^=(>Vm}HLw>1Lfe&0ffAR#jK*9hJ;zA;kS%xIU z9c;|Ydna<6Feg}iyO>tPJJ6?2ZiVXx6vKa$mUCx> zNweN`D`C>;nD>h$hMa|vkP&nnJzZBkSny1L5clH}m_rh+g=Gv!iXb&CWm`It1)@b>0y#$RSn=CeiBGop$+E3eP>7X^~k5HIi z$ijYbfQ|e+93()z%|)7m`C(JM>jt9g$gM@`SE7e%k*kS`iPwcqYdX@I-Tej5UV&DS z>gD$t*iE_>9<=o{G;+)k-T_+R=xt_wj??TFh4^LiC3M>vMei3;8KUSj^u&h1tzezR zmDfH;A6>F}kigvdM_L`+W-9P+);6Ah)z2Y^F$z9cii5wIrKX;A6Qm}@BPS2->bM`~ zK;hDl-?2+ckEWnQ*X-tSAPi3QmoVA+m@LcC3zm;N#P2`nuHu}SqEIjsVLNm1(%08E zYG=Hx?QTd|_3FWOo!I3PK_UNf!qK7D?CcND523T0n!*Y~$euVEwD`@22XclKItW;u z*`d1!1iKGkSE3X;Wngz{T$3uyrk)k=V8t}s=PzC~VS5($7AXO@F2MLH2?=#6#DKc| z>({Se%c@R*L*PP$`EP(JN$Si<(f~1N-9i?-Bz@2Pzd#*}6}-wDd)^u#K290|C(mT^ zl?k1hg7ZZ9gK)UF=zy-C1TvJg_-JP&M;E)0FAmk=Eko#V_#qcqw9*?>(Lw4LDqs)! z^;6xYF2eYP#zf)5O0MNR&mgHZfH173Qb^@OLCRLb-Os{IdC4d@R;xN3 z5KkeBI9n^D=2!kmpns4hz8^%d=!df^n+vmNNEYBU{VG>Xmpg%)ArW}qvPIv$1=ENq zk<{v#kh8^r)|V|H$ivvhxlk}@#9Z+&JkA#zU?D7ZTbGI!+mjqwqXNJ>%5$h-gn1sf5)d~+1ZEJ_!o;eXf=yh359U`#R_+Dj)H z7Mb9p6)wu$D!!EAn0-j&8tCh1PA5 zq~O}iF%erD50wpEaMmUFobO_23a1BJ5#~RQ1EoSJdjVidUo&{VCh=w69s*PJ;iy~y zROviWZ8W4o<|HG>2yf|$x2P$sx%2>UL1&@kU?`>j1?0|c7Fc-=X7G?cW`vg!n&QIv z^_-2aYuTHk`|4P=nYJO$(~`kn+2o78b;Gy~F^XgV==M!v&ugLXy}j*qyXcM;BV zL{~>jMR0RRtEK5jGbcuU-y$e2n>KAMv!G>*CJ90=yGn+2(yX-B<$Se_XId$0W1)i- zRu&5W6E{my<_guu1tFT@LeX+S;HB*X@n1c=+8l>qAdH{N6PflE4Osy!{sQy)8*kja zuult}3XDeK04J|`Jlx-mfM>|7bIFyPm$?uXfQ1QGbGtX8d6&NPQ491t>lU=mk&a4P zCWzo1f$Fs|BC{y5Eb}q*1ggUmM0!I|fZrH)n_F(A88B_0;TG^orLf;@ zAXGCDuDRHbrlSLwPNvCz-_)|Y~(%Q4P9n{s;>$0Hgm~j+DXDz*= zxe{B=e44y9rf$wB2gYxiK1g#+8sCkZdqddo1 z&AK=twFS>?5QuvQti6I{CWHIH;??!U;+9gJ24?>8srl;Ft9`B{)D?EDQVLB@)YjH6 z7x2jf6zwzjk&602E-m30OP?pWIN~D#wsZ)`d7QDk&%5eceXHrmPxaK06;)M$2^I*z z;0#Srg6?p@yEr*Kl1=on?pkaYt||7spxkYA&?`YDM9)Azic~duyS~%=mp(23AbIp? zEM6cSguh@s4uXJ=3X!TszDsoRe!xW>(PV@c8u1FmF_a?^ER%b2fOEqsXaLTCBU~n0 zhBvpd8(}0uH7*E)=oG)+ zrp|p@XsZ%3u%x;RP-u|Y2`j>BiSatx+LH_HO(W1;c*`avz#L7&!e>0VUZ`iErPbkE zPUeOT16t(AW>wF?3vp-=p+qSPpZ{|wN+X!MV$3Br~%q-q2J|sI7`m~Euj~W6C&EJ+IFj; z(%llz@?+uzI7)RjX9EwxXd2H3ZDJLvjP=tRaK==wJI=qXK%z|A84HQVLWDR*uX6u6 z$JCaAXBq+PWbAaa!${6J**0iDEQC08ownZ$7Q%~@NP?THQd@@)Z@GpCXbO0P+YfkP z7~1Po)@Z5po+>`EN<&?p&%Ko1034Uif+)ET25JYvI>dc}5nd&`S_k^7?n%Jc3x2}8 z{yBV_2__vmLxTAVg4u7{U*{2qpc7MLB_<@HZ6G?ljd3 zC=N$rI^G!HZ=*&_D;}Aw-4Qd(e@7Bd6MK=HlVkSc>NzfIa#NPIk?+NrTo)YJwj>#? zQm&ge>*&2dgkw(UXU)jJ4fmHE=+rO+hH_=OE%9JNWom1SU%1)!bQ}h8_wu`N?@C>q zA^#TperwBSHFBaxV1siL@UgOrajzz^d;@To?&`SSxk~G=KoD`>@aJQohAphw6!@W) z@9}|0&lnA-b?S3#{O}SEMP6P*MQ!&9^r?W1S0d)OjhsqbfaLLaF9DQ+V~V05-@0uE4nF=`ie)z^V|uTT@>PBGE#KF zl=v9ZKKkE48cMz4m8a%f@>)p!4P@klu*AqN=7YLAK7ubPXj9mYd$!zgfu_GY$_P zCxc0&qRIB_9C9lLhk5fw-4)+MKPGI%5k~td9ME!Z`0L!_>zm zM%30r@TbxeusL^QSypsnV$OKNTBt42j5qzpFV?-dJHWs{sDoT35fL&y-R4i~>PKC? z)G+!Z+~X2JJ(e7$sbAz7z!v)p#;1ajpn`g?BY889O#>QSM_i<~rZzHNHzm>E@O1>$B9-}p+=~xE=V3c(?*$jCr))}{ z6KI&)O13t|y}9voVAhOUawx=+A&8AHf$V+i9E@ebzUiPOxExpiq zgUu~?43Hh^5VV$QSf}LzCBaqusqr?Mqu2mp3o@i>W4|JlSYU|11C;jgs!7*uJBHr4 zd$|3MV|1#aV29MdwL=a-%oT6THj1NWAX9E0Y_@baK9yB4MJ>&oKBcnE7Ae`U`>jKLLj4;MlLjsP**PrZsD3zfq%&rGdS{@Z0zVLL!2VbI}MV znH0t)M6g7BR&^KZG9^_A!$F|;>F`#3mU$mbK$If^@h0bas9<7}D=xk0=NcDgiyaNi zBJz0~Gq+xUEHCUM~J7iA|#FLbu6U;U^&&5IjAdaQm{dIOLYMXY( znXKwFAayX2+ZRXQl5)3UDr=)_wOKQ=X54>@pfnXl4a$A9?Fm%pkr^li8>;x0Y`Q9c z>g!|#$1NXvE`WP{pT&!RXnr2OvT;jVPRUphIGfdClr78(@qqb%Q<+Lp;;^u#&n z+pksM=%TwOt{I0y|dWeHH4ZjTy-;Q?8xkR zpKeZ{?{1l+;&a_30yhK^5Ou_2 zm}6-ZbWOL=-L3R#*0+Bmft~;C*_UMeBNAWlnMGh$2pAW8P3yCz5deTx=k02(fHUB? z1c#G^QXXH3czG+Pi{loTl4gU*(jTA|Kl2Jhkeyj`=nWmMbOc??J?QI=>KI`tFA-!R zh@(VY!$6Rrh=>b|Fqa(bbRKSifo<#QjP)o9%)ya+Tc+{>Q-o41VR)1Pa8i*wX$zn< zEAu#MVK#tbt4Mumk4!J@>C_=0iFC9xj@X7CrtWrUo7)!+$Z@AOQ+Udx=qUOj& z4Gakz%}o15n~m4GZYhgC+Rqy1ZY~aY4id)t7YDJT3i#EFWXu%#ITUu6zyUE9(f*Gx z*r_%goK=05w&)XksMIitT$oVH0x5Qk_H&f=0&Jpk2c6sLhRRi`^wT5r*7Jm2fToB9 zh%_hgksW%$urvv}Kt0h(h3vE}dEs8%Bda=}{}|U~P8(%SvKdT5FhIU$JizWUeDp&F ztR@>~qM~ftfjl-+76|4GZTO+I>1ba1YU1U@M9=v^l%Y8DNU?CKLl}2fpYUbi1nCap zmLzUp~soYlJ@$k9cMgFQS%MtJp zR3KKyqdGJkX0nZPDPC|dP@A8+(m^P+gM}(g@xV@WTU)RV6H$Nl-IS_LLwq}Jgn}(6 z1#^KX+}&O-dJ+3zM@dDi|HQ%fN{~kx0MqaKD2tTyAC0#Uz}u4w^HE(Q z!$2eI;KaR`Bf35^xYkgzhvAM1{aGBg&HNJQ!>3~}( zU4@fG{1!m7XZ8u#f(Rs;B3SeQ5Vt^Y)R7_tK22UwYpNbih${X-hgk%m4~9i%&R*n6 zOK>o)hBO}*>N;RdAq#YG{Essyl@m$1o<;(VIuc&UP~`Z zOv9&~jtSrVUKQWB_GBqX%_;=Ex==IWW6}M@3qi^6u-+{AmI4rc+?`lhX#@J(n@fg*&sI7pfm^*C~t6Yqax>Z?0#m@jh z%)NsCDO1XV@%a*1xK-a{1biIP3mbF96YbVw^{HdVJVGa^RA-(h22`LiYjNc17qy%0-dG^VqXmtZI1>5u*G zU3vLk8NP%~3CdL<Hp>4Fa*y_- zzYsE|qB5r| z<(dcl(3cg`>dou&mO0K6wACtY3{DVWwmbx%C!t&9ur&M`C`;58eZ*HIs1sNQ7=i;< z)se7~l!Gl-74v?F0s_e?l6#m1ZCyfnls5F`WkNz%xfuPiRah#gPhU6Tg`BWCY-+zC zu(b4sJ`FuU+4SG|=wfp!!yV-1d}ougvscn6fu%!Wt14Wa8~g@CHqlI+`!6cNR2%tK zH4ee9myT>ALH=RS$Y7w&idcXD`gP)TP8w1zt;-ral|GwNpZ}>AACV#|5^1eQNybnw z2BG3o)HTiX?3);vLv=j=Z=6N#hf~(cluME7K1P8xi388z4W2 zxMpgB8RPM;BC&8}PYsJie4vlIlQFZ|D8Clw*?;m)rS24o2&d0nW3UK-N*%hjd4*`z zc)6&<8U?09aOk7~Zt-Zz7{p$(G6Y{i2LE| zR#nDb{pd^VLW3M^a=#<6hHSeeKDl7y+&}LsXhQmDvj|+O`Szb}` z5}1#($9J-**Fg|!xE;x6kP~Ux7MeD;Im|tX%R(yzD9%260{x|Lv(6*70`Ks-fyvup zK*(j&R~_Eq({)?Cu_j9H^M0fsX$t+Z#5?bT*kP#MDOzRF%SM=bw-ut8K9DD&_oO7M z_$2CXlt$(7ZRufCp-z>LZmqi-W0iK4!UbeLn-PeRiPQr@Iuk*#1SvA1t%uvJV4w|V zck|_@riw)KQ9-93ZC6@=bL(ga9QDui1$*H=Sp}J1xB+#PR{j4g>)PXTzT5vdd1{`; zJ!^>MFw|pg-4vlDGmN5*O=&;e4y&lAn5Ial%^|0fL&8IO<}fP7G%eIUIs9g*he@mx zQdudK`z}e(`~5xC&9m3*{$sx1zTfZXx~|W4y|2UPy11t>rR*^-)&aX|&q89MkQIEK z^#owK>Q6X{Oa>GEXpi+Q+)d|*J_8Q(NALvLz?NU_@|@})JQ{#f09l{lWWL)zS+bDV zj^#iFJS>5>p2&XIZ`$jyMk3sk@rihir?_WfzUDw&D{p75IriZ@V2pMuzVIMss2>pD zo7J|X)Z8beUWmsw^dYf0$emCNE62ah3&Q%_9OQyWqG!|A14k=zsb`! z1`j^0JoqinJ$&uKP~&d_YihdUsT|Jc2${v#144*d$NaUiQ*(3AV#zeVOTA21WPJl* z&v3)?Qd>F0($}f}s@ADue;QGs9}6AdJO&y+Y&d|9Psuq|Wl&ccpCaHQem_S$U^cC%Nnr5OFGN2h> zy!2g8N*e>;cE9Y~W)9+9&$eQgXhi8p!PZar?|oVCfTi#ZFsiezUoqHpYhz1-OT%)u zJ9kLHNn}xQ12Cs_DsC}woiyx=L)i*Jb@41N1;#!JDTbVnApFphL&=#UN4;K8@amFi zR+DlS8t@Dg%_wmjk3_T2y7?0DFzwC|DQj*~qq-C!tyv3@JilJRdjW^XLsvu$kz~l& zl?}zX={xrh4fR~3#lpDo@`V^;5QfBjd`>SlH}2`$#cy${#}kCX)%yA-jGjW z_lC@Cy5f$RPk+e@tE?L)MzVsFA0Y{scB;H%p8(0l8zeTNAvL!^k7uZ0;C3v)pW@&m zGlz`Z`5+82nd`aHBOs?mhwO;d)bt!G*u{HMUglDeR)=`U2gq1u{PYvY8mh$HFtXg= zyW#*#-ttEiB3H_34~!AKZ?HI+gM;#>(rA2mFsxmLnG$%AX6oe_ek=0|6*LsPq#;m` zRFihld`xM<4p5+A%1u`>3Xp48L1|_0R54-*J*zeASvWca2q+j9Xg`sM&L=e^bg%vD!M3isi5x=YapQ?g z9chVQ1;*$eeO+m~!A^@$LSAZgH*p z`N`|cuwD#R<$+p$j0O>-Lf+@K*Eis`vhd(BDz{=0;@@x#2Ku)}=Ky4fDhu05R&_oP z>z+w90#Un+IO7t`w&vMexf0_-*gZ@a7#HW*B5z!w4 z&-FO@z83I+2;)7>xQ>_k%`;yWWo2a>3hv%P3eZkhuP+WRZQX%(v!BaU`wKIjUAaU6 zwItX>wqZ#pSMVDoOYnR6{CF-gYz68@d$5jz>drpqfx@yMX@UUBl91VOcpcD25eAY! zIDJu{^*S-Vk+q60{xDx-&;Zfs49^W0|zVkgP%c9En`V-Y-HVolEnwFa3 z4$8S<67&yv|H=0EhYUK3{7W!6#fxcD6q^uGJlbh12XlE0L#*>2yR{ATmYIMQlmlxh zVGr{I5&uS=^`cWymO>9&jc!QM&BR^Wg%G0(=y?_J67pZI4q`~U2b-CoGE7)?8Yy9S?A76-Ud2lg`vVQ+ z!!^(XMltg(*5#l?*l1e`TweHNDJg>>wq8rV2im zI+1V*YofxkU#HqA_A7&)j_jmP&y(VZO1wm1b2G7@+4Y`IvhBvWOh z1Yw?3T}>mWQ4&C77HDj1APvDHdv^uqw5%9?aRDfu^@RDvWQCB^EebbDYMp0j`qk>u z>8p7r1VJ2w!_8`LqWibRAwL|TZmN(ejFITlVvLMKl`I3QW)cyD+hA~u$St*T=rFug zQFmBY5JU3RB3HF@rNE04+!Cy0O^rMd^B;<$2B2weT~T{z@{Q!|2aPMI?(b>o`nkzx z_dj1TWyLQ`@0>I`**SfR+eh2_uQ-6@cNLXo2ED9&nkws9h z?ePr3@bS;>(qqX`e!NVlF*3?X_cqbRjsEtpKYV!h7KdMy8(v^vpzceRKFLJab$4E6 z&RoBiVgLXfl#&SK#KJn2@&+t`2v>PScIdP6-(ru%3YrX=J_Q%F&hN_fAqIvis8YVY z7rvbdLW6IwBJY5md6vhLg+t&A4m}eEMKU`W-F(!mx(A*;>$0|l{|H^E@Yana&sUpq z*0-mXacFM$O&1-pZtNIGda51yjM+oG+hPh?#M9H=Fnkp6u_&~BUZT&|AMr~Sg~vds zta)a_lJWuosF`S1vxU3!SVs6iVT(5*kI&Wz{D{TS>u(`%`55WHdJt=&k0y}XvgmD_ z>HjL6-dALsJzPi4d3^ewCmzfaH6aIzUPys&aENB&Oz6nHj{&oL?~6Le%}U{tiC1$k3Tj=PC2ACoj?jl5?|C zpZnpfQQ!!ciAKXHWQ2+h-slmdS(n2b94d?F5+FuPKQ+;*@d4N}!IA{_iTqQB0HX#P zhcbQxOs)tPd(zM?;}8Q=Ns7fk!&GI2#EeF<`p+8Xx%bwnu`CHdu*510Ra9a>fNj~F z*@n73LCvO^+#IHhG^)`npOshA)4$TG2PUMo56IPK&*z41)Z*N9>yWUH z$r8F!X-~)os%TwQSgu4g3K(>VN_$1df|#(-Y$7kyclSDs(7+A+tPd0(bvLWA#6LnT z8@qgX^GP7{W_)1^;~d1`A6gVT$Y(9(IINIzZFslVM3|<-aK@PRvNX_L@NR^H#k)5~ zB;gwd;x%VCM}=MEjJqtaYL-xK*uJh#P67&kuzj?DNEPWuoI%Z2(~K*OQ(L=9iUeR+ z@MjXRV0br94@~NY`y?3@p8>2c?1kCMU*irzeVGsyHVu^6(@)Y8nRU>k>CD=YRj&9` zrECDqDthjfjKA)RD~$V$^VZBm;8+pla(En#sO}htj1kZ3h_dFkKPv1Zo{u<6Vcfbp z`eD$@!ZPITNiLRT$ zO3a<1(OiZoZ;Fo!lTV*D2UT3%E%qk35j=grQhbFId@>k zvm+Au`b2tz_QZt9_s%nFUzxZ?d5v2%p|^4KFvtfmg?8nF?;o(c#a5G9XvSTa2*iJHI%|Rk@nv(VERR~D;KvvHGyQr3EQVxoM zGOFK)W;;%M(4(&lrz_RgdR0T+s{dx98z9ppAJIumT7?_Wy{bb|V08ST$|#aEWW-mW z*M>6_2>GxYgOrL@MnPT=tPz#@!X&yOFw!o1vzqmInSt__+9?8LRPB#y*^2K0I#u?J zivws6eHFCB9@H~Q8}Hl zM5))xoEM)$mOovkYj||CFGtc>%it^MvNl|dZp|w$Ep6S~&^1LYLIe?w^(CQow;K8j z=>d|=y9Aomq{)TG+}bNM3NGWt34e!h!Eh(pnCQM@)CFw4iJ{e`??E3<7{bsh~*EE4y4y7Llx)JhIfQ#TNEsyg| z<}Cmtf7)>X7gj={~7Z$!vT6od(JN_$jplFJ)M_hQ?IcnJM z1}&p!`m^?{Blx{bQe&@G)<^Jw`9fI5t)SE9-xitbzU~!nOWC~T6>LDE^|G*Rz9ioA zif6mscD7r|vS=&^<|pd&gmUpcGA^ZVA2mi|kH*Z}Asw!cf$9)q*f|y3%eSQ5WCh4z z0E@I@;^iFtfk3+7scuWSL<$RSfq9>uXb^J?ipBT*Jal+X-E)=iWpw2G8&6uOwnHiE zv4>)X$o-TZ(DIsm6K1V@urd{G7!>0u_{oly{o;3x&)@}!zEZwm8C2r6{Em>=(Z#A7 z$~|z+DrBeoe1!j*f?qlt_QPbjEYIp&$mAPHcM9FLF3q^oSCn>;q3|7$0V+6Y@Eq|W z)I?BSzKBi;{?XtQh9yUN2RXh;qLKdGHW>xKi&6zrO*(DdoZ)xd84}DCyr>>w!iD}G zX>(ha!t?nQn}1LKLv6NOZVtoaYsQW<`(AZsABZBpZ4JmlT^?N>AW98N;(vuLXhBkJ z7DFni6vTmdJcNnb`&pLCih?ly)qydwgVktS4+|kMFuw+bzi90r$ z7W^~FxEbDmH3bLL_I9nS%Uhl|R{tMq$tq!hLt1>q=Y1ZD|?5(lIpM2hqzZ5rPyAvc-6|Ht|orQU@ zlt=#p;Vny!_EB@l9ar1%`As(sEOZZPZG@h%! z_mdsIi%x0ehD*GRzZ&k8rSoXx9J;#rlsYe1{iX)#*o`^f`kMjctWE=dwMHE zEW2IOHP}xZTU12AbBbK%Cv6!63nS+Dii#ZqilB^Q4*g!The&f)}%nhLnxk z)3#B9P{cJ8*W2z%`Wr~T%)X5&kN!A1Q?#MnMP)Yf3MLnbicWF-xq>pL%m_q&ShB!S zM*;`LLYxH$IZD`j;%Z*@J&%LSuV`n`AQDq%FaKrl(2-0``l-9*(vaD8CAjeGbh zyc4j{SR7445Z~L=U-{mAoarmYsR|zacY_Niwv{8!){dWOD8n!w#=>N51nT3mpGP`V zgn>}SC;~~TJs}h7^v*_;=CuZDBeVL@4j%H0d>~`O0G}Tu$r}97!J)~{sIgP&nFleB zKjXlm7oM~dWlkqOhrVKVLLH7RF|G077fwruSW2r(UykP7ty5$w@w0|-kLr8jyJn4S z>MWZxI=N5*#)2Oz2h6)F*hW)8SWjdu3@T~U7Npwb0UAJ$D-rg|+`q)jSxp>fZs6TemuYcMAnr_xGYnE2|CZu)1vL zwuwh?X#^MiOQyDQ1>B;~Blt2{YrY>Zd^B2TsL(P40ojBkoRFrPRF6*%d4lI5+ChUJ zeP-^|m4N1gZ!w(SI_P9Ny@xA3{|8oVJ`a9=iI0GDF#qEiCqr$FI4qhmOPVQR>jS4C zFewF2zupH9(lt4nCs;5$fa->Xm;s$@>YHAckO~dw9BVTd#$m-{B3`{bI^)Xr*KS9! zBDZ7jRhrVfcUQHj%_?s%GZRb)w1uk#4XaaOdFOYCd8U=HjL5s-RO%8d$(39G%IXa` z25=#)lDS@081<$G7Um!*SK3Q*d|&`3T<%hzZt!#hn4m}39qV2a!Ju|veYlmcq8teL z5NljWrp3y;#477C0ZxRs`DI}#!qH-&sadBsW0F>-h^Dt~;R1~dW8OKE-wdd@&i z41}71m`#Y7`>o+?7#~oh-vMmP#`Q5p-|(8DKcOBhF+D%dBlQ0bnLcLkwGzZh1h*{^ z8bqf)WK#7`gO&DaaggB)u#UK<)vx?fSsXbH_=E=%mmLkU$nh`}p+-i5-ZfWWNlI)| zWZF$mZw8fhQ)L#cIzc@e#&$e?ky!JBd6bklc z2tzwfqF-*vH4ObY;d%Be?6to_VFe4(r)r6zVvF3%mbc-bP2EkVAUtPr Affection UserData [Haskelloid] -newHaskelloids img = liftIO $ mapM (\_ -> do - posx <- randomRIO (0, 800) - posy <- randomRIO (0, 600) - velx <- randomRIO (-10, 10) - vely <- randomRIO (-10, 10) - rot <- randomRIO (-180, 180) - pitch <- randomRIO (-pi, pi) - div <- randomRIO (1, 2) - return $ Haskelloid - (V2 posx posy) - (V2 velx vely) - rot - pitch - div - img - ) [1..10] +newHaskelloids :: Affection UserData [Haskelloid] +newHaskelloids = do + img <- haskImage <$> getAffection + liftIO $ mapM (\_ -> do + posx <- randomRIO (0, 800) + posy <- randomRIO (0, 600) + velx <- randomRIO (-10, 10) + vely <- randomRIO (-10, 10) + rot <- randomRIO (-180, 180) + pitch <- randomRIO (-pi, pi) + div <- randomRIO (1, 2) + return $ Haskelloid + (V2 posx posy) + (V2 velx vely) + rot + pitch + div + img + ) [1..10] updateHaskelloid :: Double -> Haskelloid -> Haskelloid updateHaskelloid dsec has = diff --git a/src/InGame.hs b/src/InGame.hs index 5a5979c..c369b4d 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -1,235 +1,81 @@ +{-# LANGUAGE RecordWildCards #-} module InGame where -import Affection +import Affection as A import qualified SDL -import GEGL import qualified Data.Map as M import Data.Maybe (catMaybes, isJust, fromJust, isNothing) -import Control.Monad (when, foldM) +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) -import Debug.Trace +import Linear import Types import Commons import Menu -loadGame :: Affection UserData () -loadGame = do - liftIO $ traceIO "loading game" +loadGame :: Affection UserData () -> Affection UserData () +loadGame stateChange = do + liftIO $ logIO A.Debug "loading game" ud <- getAffection - _ <- liftIO $ gegl_node_connect_to - (nodeGraph ud M.! KeyShipTranslate) - "output" - (nodeGraph ud M.! KeyShipOver) - "aux" - liftIO $ traceIO "nodes connected" - hs <- liftIO $ catMaybes <$> foldM (\acc _ -> do - coords <- liftIO excludeShip - insertHaskelloid acc Nothing coords - ) [] ([0..9] :: [Int]) - liftIO $ traceIO "inserted haskelloids" - liftIO $ gegl_node_link_many $ map hFlange hs - liftIO $ gegl_node_link (last $ map hFlange hs) (nodeGraph ud M.! KeyHNop) - liftIO $ gegl_node_disconnect - (nodeGraph ud M.! KeyFGOver) - "aux" - liftIO $ traceIO "nodes linked" + nhs <- newHaskelloids + kid <- partSubscribe (subKeyboard $ subsystems ud) + (\kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $ + case SDL.keysymKeycode (msgKbdKeysym kbdev) of + SDL.KeycodeSpace -> do + liftIO $ logIO Debug "TODO: PEW!" + SDL.KeycodeR -> do + liftIO $ logIO Debug "Reloading" + putAffection ud + { stateUUIDs = UUIDClean [] [] + } + loadGame stateChange + SDL.KeycodeEscape -> do + liftIO $ logIO Debug "Leave to Menu" + stateChange + _ -> return () + ) putAffection ud - { haskelloids = hs - , wonlost = Nothing - , shots = ParticleSystem - (ParticleStorage Nothing []) - (nodeGraph ud M.! KeyPNop) - (buffer ud) - , ship = Ship - { sPos = (375, 275) - , sVel = (0, 0) + { stateUUIDs = UUIDClean [] [kid] + , haskelloids = nhs + , ship = (ship ud) + { sPos = V2 400 300 + , sVel = V2 0 0 , sRot = 0 - , sFlange = nodeGraph ud M.! KeyShipRotate } - , pixelSize = 3 , state = InGame } - liftIO $ traceIO "game loaded" - present - (GeglRectangle 0 0 800 600) - (buffer ud) - True -excludeShip :: IO (Double, Double) -excludeShip = do - px <- randomRIO (0, 800) - py <- randomRIO (0, 600) - inter <- gegl_rectangle_intersect - (GeglRectangle px py 100 100) - (GeglRectangle 350 250 100 100) -- Ship's starting position and size - case inter of - Just _ -> - excludeShip - Nothing -> - return (fromIntegral px, fromIntegral py) updateGame :: Double -> Affection UserData () updateGame sec = do - ad <- get ud <- getAffection - when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize ud > 3) $ do - pd <- getAffection - liftIO $ gegl_node_set (nodeGraph pd M.! KeyPixelize) $ Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt $ pixelSize pd - 1 - , Property "size-y" $ PropertyInt $ pixelSize pd - 1 - ] - putAffection ud - { pixelSize = pixelSize ud -1 - } - let nx = fst (sPos $ ship ud) + fst (sVel $ ship ud) * sec - ny = snd (sPos $ ship ud) + snd (sVel $ ship ud) * sec - (nnx, nny) = wrapAround (nx, ny) 50 - liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipTranslate) $ Operation "gegl:translate" - [ Property "x" $ PropertyDouble nnx - , Property "y" $ PropertyDouble nny - ] - liftIO $ gegl_node_set (nodeGraph ud M.! KeyShipRotate) $ Operation "gegl:rotate" - [ Property "degrees" $ PropertyDouble $ sRot $ ship ud - ] - td <- getAffection - putAffection td - { ship = (ship ud) - { sPos = (nnx, nny) - } - } - ud2 <- getAffection - nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - ud3 <- getAffection - putAffection ud3 + let nhs = map (updateHaskelloid sec) (haskelloids ud) + putAffection ud { haskelloids = nhs + , ship = updateShip sec (ship ud) } - ud3 <- getAffection - ups <- updateParticleSystem (shots ud3) sec shotsUpd - ud4 <- getAffection - when (isJust $ wonlost ud3) (winlose $ fromJust $ wonlost ud3) - putAffection ud4 - { shots = ups - } + +updateShip :: Double -> Ship -> Ship +updateShip ddt s@Ship{..} = s + { sPos = wrapAround (sPos + fmap (dt *) sVel) 40 + } + where + dt = realToFrac ddt drawGame :: Affection UserData () drawGame = do ud <- getAffection - liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink - present - (GeglRectangle 0 0 800 600) - (buffer ud) - True + mapM_ drawHaskelloid (haskelloids ud) + drawShip (ship ud) -handleGameEvent :: SDL.EventPayload -> Affection UserData () -handleGameEvent e = do - ad <- get - wd <- getAffection - sec <- getDelta - case e of - SDL.KeyboardEvent dat -> - case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of - SDL.KeycodeLeft -> do - ud <- getAffection - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed - && (isNothing $ wonlost ud)) $ do - let rawRot = (sRot $ ship ud) + 15 * sec - newRot - | rawRot > 360 = rawRot - 360 - | rawRot < 0 = rawRot + 360 - | otherwise = rawRot - putAffection ud - { ship = (ship ud) - { sRot = newRot - } - } - SDL.KeycodeRight -> do - ud <- getAffection - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed - && (isNothing $ wonlost ud)) $ do - let rawRot = (sRot $ ship ud) - 15 * sec - newRot - | rawRot > 360 = rawRot - 360 - | rawRot < 0 = rawRot + 360 - | otherwise = rawRot - putAffection ud - { ship = (ship ud) - { sRot = newRot - } - } - SDL.KeycodeUp -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed - && (isNothing $ wonlost wd)) $ do - ud <- getAffection - let vx = -10 * sin (toR $ sRot $ ship ud) + fst (sVel $ ship ud) - vy = -10 * cos (toR $ sRot $ ship ud) + snd (sVel $ ship ud) - putAffection ud - { ship = (ship ud) - { sVel = (vx, vy) - } - } - -- traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud) - SDL.KeycodeSpace -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed - && (isNothing $ wonlost wd)) $ do - ud <- getAffection - liftIO $ gegl_node_set (nodeGraph ud M.! KeyPixelize) $ - Operation "gegl:pixelize" - [ Property "size-x" $ PropertyInt 8 - , Property "size-y" $ PropertyInt 8 - ] - -- ad <- get - let posX = fst (sPos $ ship ud) + 23 - 35 * sin (toR $ sRot $ ship ud) - posY = snd (sPos $ ship ud) + 23 - 35 * cos (toR $ sRot $ ship ud) - tempRoot <- liftIO gegl_node_new - tempRect <- liftIO $ gegl_node_new_child tempRoot $ - Operation "gegl:rectangle" - [ Property "x" $ PropertyDouble posX - , Property "y" $ PropertyDouble posY - , Property "width" $ PropertyDouble 4 - , Property "height" $ PropertyDouble 4 - , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 - ] - tempOver <- liftIO $ gegl_node_new_child tempRoot defaultOverOperation - _ <- liftIO $ gegl_node_connect_to tempRect "output" tempOver "aux" - ips <- insertParticle (shots ud) - Particle - { particleTimeToLive = 5 - , particleCreation = elapsedTime ad - , particlePosition = (posX, posY) - , particleRotation = 0 - , particleVelocity = - ( (floor $ -200 * (sin $ toR $ sRot $ ship ud)) - , (floor $ -200 * (cos $ toR $ sRot $ ship ud)) - ) - , particlePitchRate = 0 - , particleRootNode = tempRoot - , particleNodeGraph = M.fromList - [ ("root", tempRoot) - , ("over", tempOver) - , ("rect", tempRect) - ] - , particleStackCont = tempOver - , particleDrawFlange = tempOver - } - putAffection $ ud - { shots = ips - , pixelSize = 8 - } - SDL.KeycodeR -> - when (SDL.keyboardEventKeyMotion dat == SDL.Pressed - && isJust (wonlost wd)) $ do - liftIO $ traceIO "reloading" - liftIO $ clean wd - nd <- liftIO $ load - putAffection nd - loadGame - _ -> return () - SDL.WindowClosedEvent _ -> do - traceM "seeya!" - quit - _ -> return () +drawShip :: Ship -> Affection UserData () +drawShip Ship{..} = do + ctx <- nano <$> getAffection + liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255 + where + dim = V2 40 40 diff --git a/src/Main.hs b/src/Main.hs index 4a1e68b..668b0a9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -49,6 +49,7 @@ pre = do liftIO $ logIO A.Debug "Setting global resize event listener" _ <- partSubscribe (subWindow subs) $ \msg -> case msg of MsgWindowResize _ _ (V2 w h) -> do + liftIO $ logIO A.Debug "Window has been resized" let nw = floor $ fromIntegral h * (800/600) dw = floor $ (fromIntegral w - fromIntegral nw) / 2 GL.viewport $= (GL.Position dw 0, GL.Size nw h) diff --git a/src/Menu.hs b/src/Menu.hs index 2436a6a..fa12dcb 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -24,32 +24,27 @@ import Foreign.C.Types import Types import Commons -handleMenuEvent :: (Affection UserData ()) -> [SDL.EventPayload] -> Affection UserData () -handleMenuEvent _ es = do - (Subsystems w k) <- subsystems <$> getAffection - _ <- consumeSDLEvents w =<< consumeSDLEvents k es - return () - -loadMenu :: Affection UserData () -loadMenu = do +loadMenu :: (Affection UserData ()) -> Affection UserData () +loadMenu stateChange = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection - hs <- newHaskelloids (haskImage ud) - _ <- partSubscribe (subKeyboard $ subsystems ud) - (\kbdev -> case SDL.keysymKeycode (msgKbdKeysym kbdev) of - SDL.KeycodeEscape -> do - liftIO $ logIO A.Debug "seeya" - quit - SDL.KeycodeF -> do - when (msgKbdKeyMotion kbdev == SDL.Pressed) $ do - liftIO $ logIO A.Debug "screen toggling" - toggleScreen - _ -> return () + hs <- newHaskelloids + kbdUUID <- partSubscribe (subKeyboard $ subsystems ud) + (\kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $ + case SDL.keysymKeycode (msgKbdKeysym kbdev) of + SDL.KeycodeEscape -> do + liftIO $ logIO A.Debug "seeya" + quit + SDL.KeycodeSpace -> do + liftIO $ logIO A.Debug "Leaving Menu to Game" + stateChange + _ -> return () ) putAffection ud { haskelloids = hs , fade = FadeIn 1 , state = Menu + , stateUUIDs = UUIDClean [] [kbdUUID] -- , shots = (shots ud) -- { partSysParts = ParticleStorage Nothing [] } } @@ -83,12 +78,9 @@ drawMenu = do fontSize ctx 120 fontFace ctx "modulo" textAlign ctx (S.fromList [AlignCenter,AlignTop]) - -- (Bounds (V4 b0 b1 b2 b3)) <- textBoxBounds ctx x y' 150 "HASKELLOIDS" fillColor ctx (rgba 255 255 255 255) textBox ctx 0 200 800 "HASKELLOIDS" fillColor ctx (rgba 255 128 0 (alpha $ fade ud)) fontSize ctx 40 textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit" restore ctx - -- t <- getElapsedTime - -- liftIO $ drawSpinner (nano ud) 100 100 100 t diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 0758306..ad5dffd 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -14,20 +14,30 @@ import System.Random (randomRIO) import Types import Commons --- import InGame +import InGame import Menu instance StateMachine State UserData where - smLoad Menu = loadMenu + smLoad Menu = loadMenu (smClean Menu >> smLoad InGame) - -- smLoad InGame = loadGame + smLoad InGame = loadGame (smClean InGame >> smLoad Menu) smUpdate Menu = updateMenu - -- smUpdate InGame sec = updateGame sec + smUpdate InGame = updateGame smDraw Menu = drawMenu - -- smDraw InGame = drawGame + smDraw InGame = drawGame smEvent _ _ = return () + + smClean _ = do + ud <- getAffection + let (UUIDClean uuwin uukbd) = stateUUIDs ud + (Subsystems win kbd) = subsystems ud + mapM_ (partUnSubscribe win) uuwin + mapM_ (partUnSubscribe kbd) uukbd + putAffection ud + { stateUUIDs = UUIDClean [] [] + } diff --git a/src/Types.hs b/src/Types.hs index c063c6b..017e6d5 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -23,6 +23,7 @@ data UserData = UserData , font :: Font , subsystems :: Subsystems , haskImage :: Image + , stateUUIDs :: UUIDClean } data Ship = Ship @@ -60,6 +61,11 @@ data Subsystems = Subsystems , subKeyboard :: Keyboard } +data UUIDClean = UUIDClean + { uuWindow :: [MsgId WindowMessage] + , uuKeyboard :: [MsgId KeyboardMessage] + } + newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())]) instance Participant Window WindowMessage UserData where @@ -67,10 +73,16 @@ instance Participant Window WindowMessage UserData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Window t) = generalSubscribe t + partSubscribe (Window t) funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return $ MsgId uuid MsgWindowEmptyEvent - partUnSubscribe (Window t) uuid = - liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) + partUnSubscribe (Window t) (MsgId uuid _) = + liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid)) + where + filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool + filterMsg (u, _) p = u /= p instance SDLSubsystem Window UserData where consumeSDLEvents = consumeSDLWindowEvents @@ -82,15 +94,16 @@ instance Participant Keyboard KeyboardMessage UserData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Keyboard t) = generalSubscribe t + partSubscribe (Keyboard t) funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return $ MsgId uuid MsgKeyboardEmptyEvent - partUnSubscribe (Keyboard t) uuid = - liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) + partUnSubscribe (Keyboard t) (MsgId uuid _) = + liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid)) + where + filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool + filterMsg (u, _) p = u /= p instance SDLSubsystem Keyboard UserData where consumeSDLEvents = consumeSDLKeyboardEvents - -generalSubscribe t funct = do - uuid <- genUUID - liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) - return uuid From c25c34c24b49c72dc22e7c17208373698d4d8969 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 20 Dec 2017 04:58:24 +0100 Subject: [PATCH 33/35] why doesn't it work now? --- src/InGame.hs | 4 ++-- src/Init.hs | 6 +++--- src/Main.hs | 7 +++++-- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index c369b4d..e5c7a44 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -7,7 +7,7 @@ import qualified SDL import qualified Data.Map as M import Data.Maybe (catMaybes, isJust, fromJust, isNothing) -import Control.Monad (when) +import Control.Monad (when, unless) import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) @@ -28,7 +28,7 @@ loadGame stateChange = do case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeSpace -> do liftIO $ logIO Debug "TODO: PEW!" - SDL.KeycodeR -> do + SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do liftIO $ logIO Debug "Reloading" putAffection ud { stateUUIDs = UUIDClean [] [] diff --git a/src/Init.hs b/src/Init.hs index fd72a07..be9b08b 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -33,13 +33,13 @@ foreign import ccall unsafe "glewInit" load :: IO UserData load = do - liftIO $ logIO A.Debug "Let's drop some Hhnts for SDL" - SDL.HintRenderDriver $= SDL.OpenGL + -- liftIO $ logIO A.Debug "Let's drop some Hints for SDL" + -- SDL.HintRenderDriver $= SDL.OpenGL liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "loading state" liftIO $ logIO A.Debug "create context" - nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) + nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) liftIO $ logIO A.Debug "load ship image" mshipImage <- createImage nvgCtx (FileName "assets/ship.png") 0 when (isNothing mshipImage) $ do diff --git a/src/Main.hs b/src/Main.hs index 668b0a9..e90de68 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,8 +29,8 @@ main = do , windowTitle = "Haskelloids" , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 - , SDL.glColorPrecision = V4 8 8 8 8 + { SDL.glProfile = SDL.Core SDL.Normal 3 0 + , SDL.glColorPrecision = V4 0 8 8 8 } } , initScreenMode = SDL.Windowed @@ -70,6 +70,9 @@ handle e = do draw :: Affection UserData () draw = do ud <- getAffection + window <- drawWindow <$> get + pf <- liftIO $ SDL.getWindowPixelFormat window + liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf liftIO $ beginFrame (nano ud) 800 600 (800/600) smDraw (state ud) liftIO $ endFrame (nano ud) From a12707d7400aa479c9a9317eb9c7e1ac339a7454 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 21 Dec 2017 00:56:16 +0100 Subject: [PATCH 34/35] there's something out there... --- src/InGame.hs | 131 ++++++++++++++++++++++++++++++++++++-------- src/Init.hs | 1 + src/Main.hs | 20 +++++-- src/Menu.hs | 2 +- src/StateMachine.hs | 9 --- src/Types.hs | 10 +++- 6 files changed, 133 insertions(+), 40 deletions(-) diff --git a/src/InGame.hs b/src/InGame.hs index e5c7a44..1815bd9 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -4,41 +4,31 @@ module InGame where import Affection as A import qualified SDL -import qualified Data.Map as M -import Data.Maybe (catMaybes, isJust, fromJust, isNothing) +import qualified Data.Set as S +import Data.Maybe (isNothing) import Control.Monad (when, unless) import Control.Monad.IO.Class (liftIO) -import System.Random (randomRIO) - import Linear +import NanoVG hiding (V2(..)) + import Types import Commons -import Menu + +dVel :: Float +dVel = 100 + +dRot :: Float +dRot = 150 loadGame :: Affection UserData () -> Affection UserData () loadGame stateChange = do liftIO $ logIO A.Debug "loading game" ud <- getAffection nhs <- newHaskelloids - kid <- partSubscribe (subKeyboard $ subsystems ud) - (\kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $ - case SDL.keysymKeycode (msgKbdKeysym kbdev) of - SDL.KeycodeSpace -> do - liftIO $ logIO Debug "TODO: PEW!" - SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do - liftIO $ logIO Debug "Reloading" - putAffection ud - { stateUUIDs = UUIDClean [] [] - } - loadGame stateChange - SDL.KeycodeEscape -> do - liftIO $ logIO Debug "Leave to Menu" - stateChange - _ -> return () - ) + kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange) putAffection ud { stateUUIDs = UUIDClean [] [kid] , haskelloids = nhs @@ -47,9 +37,60 @@ loadGame stateChange = do , sVel = V2 0 0 , sRot = 0 } + , shots = [] , state = InGame + , wonlost = Nothing } +handleGameKeys :: Affection UserData () -> KeyboardMessage -> Affection UserData () +handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ + case SDL.keysymKeycode (msgKbdKeysym kbdev) of + SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do + liftIO $ logIO A.Debug "TODO: PEW!" + SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do + ud <- getAffection + liftIO $ logIO A.Debug "Reloading" + putAffection ud + { stateUUIDs = UUIDClean [] [] + } + loadGame stateChange + SDL.KeycodeEscape -> do + liftIO $ logIO A.Debug "Leave to Menu" + stateChange + SDL.KeycodeW -> accelShip dVel + SDL.KeycodeS -> accelShip (-dVel) + SDL.KeycodeA -> rotateShip dRot + SDL.KeycodeD -> rotateShip (-dRot) + _ -> return () + +accelShip :: Float -> Affection UserData () +accelShip vel = do + ud <- getAffection + dt <- getDelta + let s = ship ud + nVel = sVel s + fmap (realToFrac dt *) ((V2 0 vel) `rotVec` sRot s) + putAffection ud + { ship = s + { sVel = nVel + } + } + +rotateShip :: Float -> Affection UserData () +rotateShip deg = do + ud <- getAffection + dt <- getDelta + putAffection ud + { ship = (ship ud) + { sRot = (sRot $ ship ud) - deg * realToFrac dt + } + } + +rotVec :: (Num a, Floating a) => V2 a -> a -> V2 a +rotVec (V2 x y) deg = V2 nx ny + where + nx = x * (cos $ dtor deg) + y * (sin $ dtor deg) + ny = x * (sin $ dtor deg) - y * (cos $ dtor deg) + dtor = (pi / 180 *) updateGame :: Double -> Affection UserData () updateGame sec = do @@ -59,6 +100,27 @@ updateGame sec = do { haskelloids = nhs , ship = updateShip sec (ship ud) } + ud2 <- getAffection + when + ( ( any (checkCollision (ship ud2)) (haskelloids ud2) + || any (checkFriendlyFire (ship ud2)) (shots ud2) + ) + && isNothing (wonlost ud2) + ) + (putAffection ud2 + { wonlost = Just Lost + } + ) + +checkCollision :: Ship -> Haskelloid -> Bool +checkCollision s h = + distance (sPos s) (hPos h) < minDist + where + minDist = 20 + (50 / fromIntegral (hDiv h)) + +checkFriendlyFire :: Ship -> Pew -> Bool +checkFriendlyFire s p = + distance (sPos s) (pPos p) < 20 updateShip :: Double -> Ship -> Ship updateShip ddt s@Ship{..} = s @@ -71,7 +133,32 @@ drawGame :: Affection UserData () drawGame = do ud <- getAffection mapM_ drawHaskelloid (haskelloids ud) - drawShip (ship ud) + case wonlost ud of + Just Lost -> liftIO $ do + let ctx = nano ud + save ctx + fontSize ctx 120 + fontFace ctx "modulo" + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + fillColor ctx (rgba 255 255 255 255) + textBox ctx 0 200 800 "YOU LOST!" + fillColor ctx (rgba 255 128 0 255) + fontSize ctx 40 + textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" + restore ctx + Just Won -> liftIO $ do + let ctx = nano ud + save ctx + fontSize ctx 120 + fontFace ctx "modulo" + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + fillColor ctx (rgba 255 255 255 255) + textBox ctx 0 200 800 "YOU WON!" + fillColor ctx (rgba 255 128 0 255) + fontSize ctx 40 + textBox ctx 0 350 800 "Press [Esc] to exit" + restore ctx + Nothing -> drawShip (ship ud) drawShip :: Ship -> Affection UserData () drawShip Ship{..} = do diff --git a/src/Init.hs b/src/Init.hs index be9b08b..d377e12 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -68,6 +68,7 @@ load = do , sImg = fromJust mshipImage } , haskelloids = [] + , shots = [] , wonlost = Nothing , state = Menu , fade = FadeIn 1 diff --git a/src/Main.hs b/src/Main.hs index e90de68..41560e6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,6 +12,7 @@ import Linear as L import NanoVG hiding (V2(..), V4(..)) +import Control.Monad (when) import Control.Monad.IO.Class (liftIO) -- internal imports @@ -29,8 +30,8 @@ main = do , windowTitle = "Haskelloids" , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 0 - , SDL.glColorPrecision = V4 0 8 8 8 + { SDL.glProfile = SDL.Core SDL.Normal 3 2 + -- , SDL.glColorPrecision = V4 0 8 8 8 } } , initScreenMode = SDL.Windowed @@ -54,6 +55,13 @@ pre = do dw = floor $ (fromIntegral w - fromIntegral nw) / 2 GL.viewport $= (GL.Position dw 0, GL.Size nw h) _ -> return () + _ <- partSubscribe (subKeyboard subs) $ \kbdev -> + when (msgKbdKeyMotion kbdev == SDL.Pressed) $ + case SDL.keysymKeycode (msgKbdKeysym kbdev) of + SDL.KeycodeF -> do + dt <- getDelta + liftIO $ logIO A.Debug $ "FPS: " ++ show (1/dt) + _ -> return () return () update :: Double -> Affection UserData () @@ -70,9 +78,9 @@ handle e = do draw :: Affection UserData () draw = do ud <- getAffection - window <- drawWindow <$> get - pf <- liftIO $ SDL.getWindowPixelFormat window - liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf - liftIO $ beginFrame (nano ud) 800 600 (800/600) + -- window <- drawWindow <$> get + -- pf <- liftIO $ SDL.getWindowPixelFormat window + -- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf + liftIO $ beginFrame (nano ud) 800 600 1 smDraw (state ud) liftIO $ endFrame (nano ud) diff --git a/src/Menu.hs b/src/Menu.hs index fa12dcb..bffa789 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -80,7 +80,7 @@ drawMenu = do textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgba 255 255 255 255) textBox ctx 0 200 800 "HASKELLOIDS" - fillColor ctx (rgba 255 128 0 (alpha $ fade ud)) + fillColor ctx (rgba 0 128 255 (alpha $ fade ud)) fontSize ctx 40 textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit" restore ctx diff --git a/src/StateMachine.hs b/src/StateMachine.hs index ad5dffd..3e784e7 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -3,17 +3,8 @@ module StateMachine where import Affection -import qualified SDL - -import qualified Data.Map as M -import Data.Maybe (catMaybes) - -import Control.Monad (foldM, when) - -import System.Random (randomRIO) import Types -import Commons import InGame import Menu diff --git a/src/Types.hs b/src/Types.hs index 017e6d5..4f424bf 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -13,7 +13,7 @@ import Control.Monad.IO.Class (liftIO) data UserData = UserData { ship :: Ship , haskelloids :: [Haskelloid] - -- , shots :: ParticleSystem + , shots :: [Pew] -- , debris :: ParticleSystem , wonlost :: Maybe WonLost , pixelSize :: Int @@ -33,6 +33,12 @@ data Ship = Ship , sImg :: Image } +data Pew = Pew + { pPos :: V2 Float + , pVel :: V2 Float + , pTTL :: Double + } + data Haskelloid = Haskelloid { hPos :: V2 Float , hVel :: V2 Float @@ -44,7 +50,7 @@ data Haskelloid = Haskelloid data State = Menu - | HighScore + -- | HighScore | InGame data MenuFade From a9fc5f24f66d49da647fe67b76d80f28f120d9cb Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 21 Dec 2017 05:21:20 +0100 Subject: [PATCH 35/35] playable! --- assets/haskelloid.png | Bin 6424 -> 6774 bytes src/InGame.hs | 117 +++++++++++++++++++++++++++++++++++++----- src/Main.hs | 3 +- src/StateMachine.hs | 2 +- src/Types.hs | 2 +- 5 files changed, 107 insertions(+), 17 deletions(-) diff --git a/assets/haskelloid.png b/assets/haskelloid.png index f633deb21ea3235c53516c2757796e5c2187fdd0..a4b7813034d80262afc6b147a6d6b3a1e4271e32 100644 GIT binary patch literal 6774 zcmaJ`3p~^7|KD7OTu+fBMNWtg${{OkZc(OENI$J|N(afd6H|z}Q@Itou9$mhIYnFT z$U>b`XEm2xTC-FbQeui}{GVqozh3{>|Mh>F*Iu6Q^L#Gv&--(EzRv90xm9(^iX{jH zLe+iS7B2(>Spa^G6j5NsuI6(Z_(C1_*t!KV3x8-2%5%Yr(x2P>!ok-W_=_xVRT~0} z3S{>kt_r;>T1X>veXSQ+2*e6m_bpC7k*`Ot<1-HQMWqVj0yB`jZCifU`t&x@`@@$m zuCLLP9v|mQ!uj?*Lpl5RvZ|&E%hZ(4eTh6>T)AVlhLh~=Aa!FSQ{!4jG3(hMIW}I( zU3$7&-p%`+UjKYSj`#DsE0S+AE;%VdbkaZ5f@%CLMXyhY0n46krq6~oorCS~ zj5UpWV`y=a-%U+t&UszRqG@yN>}M%Mh;uGz)1$!y^&?(gZkutpFoTI!J)ih_V>;g9 zjoOBioRCX*D4&Iu*}GBkDveunxFi&pg#BtJR$W~%>cs9IN}+^XrWFYgVM_W+l0eqi z66F_><=>8(794kGuPS<7dQ)Kan`rkl#5t$QZ9?=KG}DRAce_$m#yw4ueQFfLC3U2$ zOZwx}TS$m2$=S)2ns`dMERcR_^gNg3#wA&l?Goua+Vmz-Y7WK-(F(K$RY*xc3Oups zT~jE?pb7SGFBGEVLmL$&fe$9RB(-~yJ=F27rm~JGxWSAjxTZn219Ef!m)!98F9!Ux zE#EjdS6bBD2${4X(+E=_X+Ln*_w$=+Ycc&AL&(HRE^tYGK>3)|PdQ2d;U%tY0?E7`L$HEJq zsLjrvGmJ45QGXIq(@kqBVou+y=2$hoMX%qEFp1-8x3CKPRzP+4Vp~XhH_k(KVFgL$ zqvv}%N$ir6(l>QcQ$^Y3;?dG?)@t%86M6STmh@3Qk$02|mWf9Kar+K_KA7^QL`-Pv za-a#;IkAx+mO^1cMJ8`mDI5 zGP{3DrAU3ksz*$vFU8V7L|z-0FBDYD2$zfS123J4VskRzzw&~*ab$=-hy>3T5aF$_ z6t0s63QhjMoPOIZ1?;%ki9L0%k6$n89~-*a7psSxarBi^2boL>|I@fGZoJ}oRqpi4 zx>R*BhoL7#Yma_iU{@PhdJ@@yE|8gn;b%uc#Gs@C3F_Q#5WUdhL`rzW<8if@ylpy& z-xOisu2BGW75$w7MWo2h9g&lscyn)js#B}c+{|f84D5}UCW7J7;OU+?O)))0?0!oi zzWOCSXC^!3QUZ8r3?ptCpEJZ%&(4_j)bI{|x-z$ToR%iCY=>ZL(FODUKGmu|AZQKk}QS3>kd#-!Ev1w z2p0vjBr{J;`2F4&j0kVEzyh878j^mbG<)Y#Fy@-kqA_cJH0DREm4#^ipe2jYo}q*z ze=G-%(xjW?;*)NOuM`GW(GM`3SAH4!H_5tBmP=Z`;9?E`)E8e!nxBERVpzI5v?cwC z=`Ul#XB7WHJY7AXR%r&-LN#EeF(gMQ8sue@pUZ+4TPbB>-I~k6Gy_dws3!!Q$4R4% z|JlC?Ne^HUO%VUwqD3|pQ<^LA zvp3@oRw}5dpzF0u;)>c!frQcKGYzYjIcSLKXO-6uq?WLwd(pAsT+$vF6S1mdL7gMp zk62$T9yxnTe^y>h7poM(Gm0WALDE990C4r@E)$}`M;#tu5nc|=$YU8F$HM!Q->=8n zUh2!g80h`Qv-4xuw_G3fE-Tx}1E-^Nye@^k6(+9nxK$U+yX~VMd{gMZTnp=5kuZ8x zHnUIC={7iRcG6T~y2p2R!Xbat)gk0EU4??o)>nDa(TCdwY8lp_c1}#;FRtJ05FElT zsj09b=j0P7e`z5Zb4hxvhDTz;L>9mL@eR8QYYi+Rktr}k``6vQT{Ig2x*+t$)u%4g z`BFi1JBdy2*?ilz)dHuQ?5X>91kIzI-u>QPK;dneF(k3~^d88`WKTDmU^`7XWL9-iHSx1 z*;r608;sa$m^G&QT%O9Y6lmHGWNrAnX(1B_J2e;3FjapfRtuV?3m~_EkXvPfjcdyX zL6dmx$+^Mttp1*Rq*_u05eH0N7tbZ74sO+6MHzV7>4lY*1o|mJPy80W)P>@9!XjK- zy@2i>P}@|bbs3a=AZ5|h_t4X@tDyXrNx*CZYKLOMO&LW=;AOCc?Lb0VQg8jEC1n~N z-h*Q`S^u>!sA7WmuJ<-w>JW&i7O3=1q9n@rZ8a$O4rB(HF7#g5L%G+=KoLF4o-3A( zYpVcaI&djFVq3L9ldOFK1prz=w%d~~NM(42E{7*=c7Qmv)w{6ozs+fCP0dq>lxcgh zARyfxll-@orsNwfq*SmRbq^FXKwE1G;KDSRn55D6lLvKsgG5-g=JU$Ao|y_x+I`Eo zIaBOYkPQRGPg@}gJcJR`--}YYF)|VqA=KVrW59E{<}vCcT)FnF9q4ZEK^JJ^3e@X?=xQYn`;B!W%=mO zyeW$q;9Rk<_is%znW)|VxGTKx;nRz=G|h8MYw>^Eo)S^zLFEN)4FNoFzGyKP>Ga=>15zZ zN%QN_i}sU-<|P_Na+trO2YL!h#gp1@sV^=yCTYHwgJEaY{4rJZ(p{{1!KClu_qKl3 zwHP@}^p>+h-XT^(bg+}B(yBurD~*&l1`WBE<$GPVO!X|e7X6jDvd*b>Q)#~C_aXV; z$1043HXg_Fe3%&KQGS$=;gH={742yA3&0ujRpsN z!2y3Um$ac+)kUeb?LW7LHI_xZb&kwe1>Z#Y)`BK9qi8m}^j>^e=Y!7V5~+wWgZmU+ zd<#2O{~vrDmssJ%^xL;wl3aLeZ9HDPRw(ITM)eS_5{S>UKakiHHck87*+uOU zpEet0u5e`fIWqf{#j2NMY;%UncStY|-pxsa5mY_ezpDz(#pbwK91yUn;S7_9-C=~= zydmyWUA6H8Ntv?I98IAW=(rb8^g1;M}FU}lo)+OUN?vB>sqvXLH zx7t;NS6y)ux4~|wkOA*{E81FBoC;RH!G382J=o5c{NQj*qE}~DbKvQ{7CL&fFOP5x z#F@=&pSM%?GJmq~v%maXWInIDpcB}VR%jxaX4#+ezh>{5M2{*hBlB>g3~%jMeS)L9%EmZ}##JJ{;u1|#9L zj!R1R)ZU2^GH_f17sVxQMo;F^H0-4o2ZN!>xWK|afJ~Jq>((lZbbH(6z13OtrDR<) zLWIxC#2Rh-X>PAj6Ykya{WCuh$wyt60oEVcG(qF7b7Cfd61sWg_XGNKJ4cN3K(6EwD zf>Q#DR)h>rttixJjK=N8`CC1rgHS&C)(*k}VSQqo%*Oxr{SkXYJv-Cm^-fou6YwA_ z3FP?@!+V(VpxC9en71x!kS?EwuK%X)ZTZG91#RNt=ltmJ6WO=KO+NbB!1_Qox`mKR zq%wK-)(8%Fe|X;ruZM)Vn3eHhxfXlNQC#l`(AxW7t#wtrv$K@nU5X7vcr78*R#mQB zL0zyt1SpNO8qCkE!s=@>yoS6E+Opn0Z53RPrd)!B@w4jd^^a>zU)7e(_P70!KD!?y zHYqiZ!5zIRj7zO3ujFN^-|V@){z^v_v5hs}zggx!Ij$7(a;E zIG#&jK!arVE~<>uUOZd}VD#Af&%yM6{ls$2S2Wjxt+7G!UN`7IopG48PxC_E^!pSu9iO*}p3`UG`ySsvS%tR+acJ z?8i4sg*3SwJMnSay)ruvCW3Pb@RvlmB`d=wYO9d8c3N-Gy8fEK0D_=xk#HVi%l$p&h=^%-yMqL-^Av*K)Byk zz=br_YVC0T?@!ELSdSuY`DotmCqY}lqgS>sbOEILb8xMW_9Z~16cXm{U$$vKek#saKMvF_Z zLO}KOBp}2pbl2b^GJZf8LFWDI2(v5V7Z_@_`i&>o4OZi%GZF^{iHx^fbit8%T?V-C z%)Rt2Q{{k@(QBx*DRm3;elUVdC`XAoTl`gil3cW%V~vF)^RA4DdZ^s}QlVgJ>O#cg ziN_42ASyw@UGcC|0B`O}%ZFDo*rsV;P2<_e6Frb(&R^qP5*_l3&dc}Of5D5nBXp&B zCG5|5XK=eS)|7OxfR9(o@;|W5&!T9RNJnO=JS>A9XW@FH0!TnI-p-M&bE1gc-Ag;A zSm2jPtcidXipF~l3h7eE-e38*1c9r7H*KKvgmV$#fim!>bC~IuA~gsgi!o-=Wxqj6*^ z7#S`OmfKBG|C`}tYWZ_5NuVO_QyZy&&Z`pE2z+s$aaP@Ha14du_bY?$aI1|}HrjnB z^vgytJIQ;7@jL7)K5yH%?XCy@sREZU176%Ph$jb`&*mtdtik4Vn9P;>KSej!H03o6 z_MN3z$?f_k1bZNQU=T@y(y0m4jQUEA&qYg1MUOQKCO@Z<@_DZyW8?u2Tc4jMRw2{V zbg3zns;+0Ok6pTHHM6gj+kOacRok5C88PAYkD`6SD-q*6ousuem{Jh-Z6V`T!Bw7d zqDMR;3#mOHl%bgWMFJIMUNvRf5vB#0eK=0CAfwTsh;$Dz1AH?2s?mA`od`}zU zxY4j3#woh5>rKTpcvrv=3_-RKbP_2wp^`cg9#|l41o6b@Q(>-b9T^jSNr!Y&m9k|F sB?&C5*13v5xY93bAD?}0Rzbt~*9&>xH&2595Fy-McW$}m{Cnd60HfW5&Hw-a literal 6424 zcmYjW2{=^i8>d1kNiJEkjigQ1D0}uuDz4OoipVlEHAEOgiHI;QmZoT<6lpboH%x^w zWa*YBnqgv2rmPvsjArpkU__Zj?VTaFR@Q<)KI2}AMIqtSU3jE4|egFkBcg&1A3wSohYux>TB}J&s9f3MwB6^_wUHilmj8#urtw)zQ(E$f zo0E!C@8{EKXk6;kedtrZyW4Yvi&t~cCWl7ubZlun>#-o%TC@LNxZ+}`JEyx$rT4yD zaPzswhrcy1JtH01{Ily`f&2GGVL?7CBZJaI+Xoj09jOX!pYGU}Ffz%GNV4;ibWSi> zPfF?y#3Zn~?w5F-=WjXF9T#`}*vE#p$C|T33z=0@8ka;Uyl=Uw$y;Tv-Sg;EzdF1F z7uk;;Xd=wYp?K6X!y{KOQPt4Z(51(k)c%L#DeZy_kBf>k^7sr!5*61LR%W>1Mr_4U ztj$!~siefgOqGxL_6v5;26UGOX&4#Rh?XeKa{M|vQtXmm-AtV-t&>XbeeUFx7Bj-s z=`V6mRDDxJufALRo}xFP>OH~AcY;0|chFzbYHvr_6-}>{h<|T6qeaKbLKaKuID6?{ zEiE2dR?xPHr@lM3LUH!AP-;j>m zVBwp~#%4?kcRsr|0a@HA-K91sB@LEobKT4q1zE`P$g1F7TF7cG1s-{&z`zEmaD19A zFYrtihAb4w-7DPR^axNjtOvfA#Pj>#8A3H1rF-mPzfZ(J1)K!pIMMFKgaT{gBT z)KJVw;zc22zn-8XaAq$Zcb&wRct3y`s>ege19^|O<@{%wQFuE?*Maz6o2t5l@;g(W=oL-t`D)9Y;PrlGjP@W~9O z<`ybO?N4MYPXAV#yyjL`&SHUQhA>YPh|vDT z&t?12apt+~n#Y)W&Z_&S#m2oC!KC=H|F6$9HM8k zoQNLTLTR6M(|>&LqybG_~U1q%|eE5tpK< zl2O4i2<5mW_9h@S>To>#s0LXm(s3_W7l@Nqnx}pvm^jBx_)W5l!5`qS>-@uFdkpf% ziD(Moj^6v=4~sQAvHyAYa#Oek40FlEu7tZuW&@IN9;+K&I*<*Mr%^y|#x;XSdhZheMoMA;KLs1-xK|2OxSY-=9Pjr37-1*qD_ct zAX7j%++1Khbg13-L`Tk1(>ZFBff;80zHl_atNq~B?V}d9AIIWH<@ANGSG^6-P){1} zkXCN6Jkm=XvD| z91tHAm*O!-g!VxcZJxT?dggzWy?Nq^#$54&4ZTV$sk4uiudIPu<3_tOL6skTp~Aps z&c2_tni6edNG7<*RK^5o=774mdh3&~-+6DaiG#<=7t;30m;dOuRT~l{`~KwUqD<<- zKW{MP-R_(+8oe?T8~pid@vhYwCto%Uyb7(MD*X~3HA>ZIJ&Pt;x@Fit?S}Ha~^9Zee1~)wq#QE z7!#%nq9Mx37i+6B=%aoeGG=O~wgge>J6=GQt7sbY{%4b5+F;%EM_j-(Ba==x?vSty zYlVTiOvg!Y)u+@N#bchyFQnt#D)!8W;BB}-Ss>RP&YDkKH=^T1HH12PJUCp?ebW41 z5UxBmtN)TB`0ium4T`D?-eA>0bw=_<3bF_;8UG!9b2U3#)YumbF4R;uc9<2{v}^LV zvAi}lmBh|nN(;R@>#rp+c$x7cRhYM0Ah-Vzp;T^!*rzQpNEe3Gr{2{%@N7Ly-v%20 zS~6URO?rovnMc#oLo%ZPnA;cc$7i^ZlvF%et6-eouc`C*G z=d0yzt1K@W#9kn~Q;wr(Ph6@?Ed+Ql82elqMQTHUDJ>2BMazIOH%|4fs%r;T_8=eq zQ7t3RK9K3J4_RDJ9^a$#Y0J1ST+Z7-AV)qG4<}v_rkNPof+l0cBZCsxxqx%q39bya zk%{=WVy9oj`LGu$aakR!bJ?%2(FNyvZG;!#I{liCdz3w12*jx%jeKViVIY0J^*mK6 z-i&MkrT&l-=RIf?;$24w{{RI@s-3nIBO7Th(Y@xXiiQUkw z@wg~wI*8!zf}pm-hAKBw&;^QW>zVQOs>onapL)*8ywN&YnAUA%t1xHzDekB?RY!`Z zzjEIAi-!oP`Nnb+pXKEQlJ!U&=z`eMpEkNfGwT==&A4?(2q;}@S>zh3 z-be1iUwe4!_xtw--dIBOT~63_&6+f=nHNXOU)2`)Xt?DrG0u#ksz{b89!KqKh$k+; zHkD*!^h6Z#xX3O>z-z>}K=1rIToa9Kl~e<5zCWAd6~bxEbhOgPW=?(&r9^H`=!G7O zP`p0B(BMNYzZgf~xKxQ;2Q#&C!Ibj|jlMZ|;F1?}yjAOn-hD$B>bH_a(m-DS5XGpD z_*CcTN1O!5+ZfJrcxJkFgs{P7z9gDuc`ZP22HmCMHGd6K5KCN%j(=r&p&VZXZvA?V z3n;gt8P{8#l#Rr0w49D|EI;hk-x@VG|80T z%dY>QFY}GRvAha@x{HJ2xwo2{fQ$%JDQ=)`4y^OL7U`BK&-v8flUE?KGi!N(E{fY| ztqXGEa_aaFOmF9ubMT45h=KvA?&OP~Gbje9SWDH?wV_9ANKmLly$K9;05wf;CY@k8 zX_IC3==)`d7V(wO*TLHuj7*9NHS5xsh(+d#d2E#)N0p&}#OC0UgLyf__7s#6C>)OPM?? zOnXS`+2Dfp)}efm5y<)XwcQPes*LdH>$&W=O0>HUkhu~bEjq~0i`p}5;Yg%om2@a& zxy-?ccfS~}&A7MyZFhk#_=CwyY@=18GQ+ovI1lm(y$N`)c}JDJ*5uV zH(oy~+0&m!EfoZwt)?qhbsMb2lVz(70wIg&2C~V8Anzcz(Prh4V4V!k)&>RRcl;oz88KX29$L=G)<&C>3No!3vo8HA z`&zm_wc9mj=v_3HX^09fsmnZ!;X>XiR%?lxL&>$b9Y3Z|<(MUEF~UD@p=G8m)dpMJ{KeItDJ*Hwt5w4YF}kp-s+&ZmXc7MbVK2T6Yf0H?2Sff9n3YoWp9+DlWta)h^lc2!3kX)DM0fTIewEOJ-wpEL=Wf-ZW2dES~=Iub<3t zcg@et0O&k?U`^Q1PpvfNj&)g>M2D3(1^&8JTbaSP3bLU#gUJEp@di9uu?Z((8A0jk z%#FeZ!DnA~%nWEZBD3&0)#^3>qx#zlzf$Fv%8TVbys-R z&Z;LX=>}CMj0f(BD^vSCM7bK)03$-jn6K`@G$v6a-}C>M%XXmSwp~@d~a}N6xbA@43O$bi3PwnIGJQc7%WM--lk>oUEjp_ zLrM4`)fN(+k8-V|UYbS~_%pgMz$AbADna0T>=b-9-7}%yLK@+JKS`END(Fnh@11$u zr!bOKSjqkil_W~*J!)l3=uxI=t=-ahr;_QwpZ3%P6W>?QJb;9E+|gbu>{c)>RT*Kh z8&TAg5x6v%t}yC4>Msk*-YZ+-Xf3i5dBI zJw?g$dCy6B_9h#5XCb5tapBSnb>A6e5niGT|r^VFALE@YlZ z&Sbjbc7Q-ec=8g=n19*)x3?Iub2=2&&$WbzZhDvDkz(X*p}HH4_;7ASreB>CKxqgE z11cim-zYSwycSfJNaj zg_ZDRxgBByd>?-TXn3Axg>2`se341*?{a0aM~C#pXegNg&ynv+@pFdzDontev?==! zZKfzysHi6Ny!eR$BQ!`9RH@jfm*Lor2h3{{chYe>5Jk2?Lkq4bZPM?>7H75&gUJ6y z$0!$cV4UH37ahEI9*@oQo9JNt2lT*D~gJ<{nA1AIlh z8};SQT_R~MvX;Y+*7K=lssi#`}_=AVtMyM)xUv`n@w$&5K z&3U>MsV%zV;Mm+F5HthgnhX0yDSsEEO-HKuuMF)b`};s)RMn_CP(!c;r?Y?W!P>zo z;$$Tc0J1)px#`$JF(Ci=e48_9t(mD1h^YA(+vlcpnmV9rH`;&N-I=OF%acSx{Z!3Rzqsj#&#Z(j}n9z`+EI z%fQfUh&L9D1eaWxTU=OO0T2B=X0yAv3N6B;n-L4n?4_M!DGxXW=u!6DV>7{(rVH`c z4R9UDDt%Y9l4>4;C3ji>kiw%^R2!h+6UE3>ye4qOPpP_XDOGZ@HpLkkxIKr$fWx5S zZKPxV28hLxGUc~bZ=AH*I~4yP5=toW;zVFXJP}z0y8+@#;J9ICOFg+|uBa$MRp2h| zuxAG@3g|%+4UcxH!wp*U(4n5~$SPb%fd@z4jK&Rb(V?cAnN!<-t5*gGp{rNfopZ$R zw#S;D6)H0tgr$hx!>ph1-E+eDR1uE6cBGel(u z741m~7}ce8I}(>h93U>u?x^2rxb6M6*`5uXy@TMQx?1qIudg%zWh-oP3+@%5WGacd zQ=6hn87^uHP~?um^Z#`1M9$1qibcCuBB{%AZWahxR9&H*w>$?2s)cI+)PEbN*)rp5 z*eWKI98{$S90Sg^ffc0KLRFxkmIW8H!6h-$NfzV5gvx%6@4)H*jx!BdvW-i*1V_~c zYkHdH8wEHLIl+_>ubg4!N%7Er4+SG4abee{9EECyYpFXD<=^02abr0h))oRA;0Ylg zrmBG{xLBAOr6dpY&>qk!>_o)gK$?j@Z}4A%_f&&*3aiu}`vzQDZ=whp$QT<51ZD}9 z^Sp@>$V~r@#54hU@(uUmXVofK#Mx= CA_}Mg diff --git a/src/InGame.hs b/src/InGame.hs index 1815bd9..1eefe50 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -5,30 +5,40 @@ import Affection as A import qualified SDL import qualified Data.Set as S -import Data.Maybe (isNothing) +import Data.Maybe (isNothing, catMaybes) import Control.Monad (when, unless) import Control.Monad.IO.Class (liftIO) +import System.Random (randomRIO) + import Linear import NanoVG hiding (V2(..)) +import Foreign.C.Types (CFloat(..)) + import Types import Commons dVel :: Float dVel = 100 +pewVel :: Float +pewVel = 200 + +pewTTL :: Double +pewTTL = 10 + dRot :: Float dRot = 150 -loadGame :: Affection UserData () -> Affection UserData () -loadGame stateChange = do +loadGame :: Affection UserData () -> Affection UserData () -> Affection UserData () +loadGame stateChange clean = do liftIO $ logIO A.Debug "loading game" ud <- getAffection nhs <- newHaskelloids - kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange) + kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange clean) putAffection ud { stateUUIDs = UUIDClean [] [kid] , haskelloids = nhs @@ -42,18 +52,17 @@ loadGame stateChange = do , wonlost = Nothing } -handleGameKeys :: Affection UserData () -> KeyboardMessage -> Affection UserData () -handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ +handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () +handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do - liftIO $ logIO A.Debug "TODO: PEW!" + liftIO $ logIO A.Debug "PEW!" + shoot SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do ud <- getAffection - liftIO $ logIO A.Debug "Reloading" - putAffection ud - { stateUUIDs = UUIDClean [] [] - } - loadGame stateChange + unless (isNothing $ wonlost ud) $ do + liftIO $ logIO A.Debug "Reloading" + clean SDL.KeycodeEscape -> do liftIO $ logIO A.Debug "Leave to Menu" stateChange @@ -63,6 +72,17 @@ handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ SDL.KeycodeD -> rotateShip (-dRot) _ -> return () +shoot :: Affection UserData () +shoot = do + ud <- getAffection + let Ship{..} = ship ud + npew = Pew ppos pVel pewTTL + ppos = sPos + ((V2 0 25) `rotVec` sRot) + pVel = sVel + ((V2 0 pewVel) `rotVec` sRot) + putAffection ud + { shots = npew : shots ud + } + accelShip :: Float -> Affection UserData () accelShip vel = do ud <- getAffection @@ -96,10 +116,13 @@ updateGame :: Double -> Affection UserData () updateGame sec = do ud <- getAffection let nhs = map (updateHaskelloid sec) (haskelloids ud) + npews = filter (\p -> pTTL p > 0) $ map (updatePew sec) (shots ud) putAffection ud { haskelloids = nhs + , shots = npews , ship = updateShip sec (ship ud) } + checkShotDown ud2 <- getAffection when ( ( any (checkCollision (ship ud2)) (haskelloids ud2) @@ -111,6 +134,51 @@ updateGame sec = do { wonlost = Just Lost } ) + when (isNothing (wonlost ud2) && null (haskelloids ud2)) + (putAffection ud2 + { wonlost = Just Won + } + ) + +checkShotDown :: Affection UserData () +checkShotDown = + do + ud <- getAffection + let shoots = shots ud + hasks = haskelloids ud + pairs = catMaybes $ concatMap (crossOut hasks) shoots + deadHasks = map fst pairs + nhask = foldl (\acc a -> filter (\x -> a /= x) acc) hasks deadHasks + npews = foldl (\acc a -> filter (\x -> a /= x) acc) shoots (map snd pairs) + children <- liftIO $ concat <$> mapM (\Haskelloid{..} -> do + n1velx <- randomRIO (-10, 10) + n1vely <- randomRIO (-10, 10) + n1rot <- randomRIO (-180, 180) + n1pitch <- randomRIO (-pi, pi) + n2velx <- randomRIO (-10, 10) + n2vely <- randomRIO (-10, 10) + n2rot <- randomRIO (-180, 180) + n2pitch <- randomRIO (-pi, pi) + let ndiv = hDiv + 1 + if ndiv > 5 + then return [] + else return $ + [ Haskelloid hPos (V2 n1velx n1vely) n1rot n1pitch ndiv hImg + , Haskelloid hPos (V2 n2velx n2vely) n2rot n2pitch ndiv hImg + ] + ) deadHasks + putAffection ud + { shots = npews + , haskelloids = nhask ++ children + } + where + crossOut :: [Haskelloid] -> Pew -> [Maybe (Haskelloid, Pew)] + crossOut hs p = + foldl (\acc h -> + if distance (pPos p) (hPos h) < (50 / fromIntegral (hDiv h)) + then Just (h, p) : acc + else Nothing : acc + ) [] hs checkCollision :: Ship -> Haskelloid -> Bool checkCollision s h = @@ -129,10 +197,19 @@ updateShip ddt s@Ship{..} = s where dt = realToFrac ddt +updatePew :: Double -> Pew -> Pew +updatePew ddt p@Pew{..} = p + { pPos = wrapAround (pPos + fmap (dt *) pVel) 0 + , pTTL = pTTL - ddt + } + where + dt = realToFrac ddt + drawGame :: Affection UserData () drawGame = do ud <- getAffection mapM_ drawHaskelloid (haskelloids ud) + mapM_ drawPew (shots ud) case wonlost ud of Just Lost -> liftIO $ do let ctx = nano ud @@ -154,9 +231,9 @@ drawGame = do textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgba 255 255 255 255) textBox ctx 0 200 800 "YOU WON!" - fillColor ctx (rgba 255 128 0 255) + fillColor ctx (rgba 128 255 0 255) fontSize ctx 40 - textBox ctx 0 350 800 "Press [Esc] to exit" + textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" restore ctx Nothing -> drawShip (ship ud) @@ -166,3 +243,15 @@ drawShip Ship{..} = do liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255 where dim = V2 40 40 + +drawPew :: Pew -> Affection UserData () +drawPew Pew{..} = do + ctx <- nano <$> getAffection + liftIO $ do + let (V2 x y) = fmap CFloat pPos + save ctx + beginPath ctx + fillColor ctx (rgba 255 128 0 255) + circle ctx x y 2 + fill ctx + restore ctx diff --git a/src/Main.hs b/src/Main.hs index 41560e6..41171b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -31,7 +31,7 @@ main = do , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 2 - -- , SDL.glColorPrecision = V4 0 8 8 8 + , SDL.glColorPrecision = V4 8 8 8 1 } } , initScreenMode = SDL.Windowed @@ -61,6 +61,7 @@ pre = do SDL.KeycodeF -> do dt <- getDelta liftIO $ logIO A.Debug $ "FPS: " ++ show (1/dt) + SDL.KeycodeO -> toggleScreen _ -> return () return () diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 3e784e7..946da7b 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -11,7 +11,7 @@ import Menu instance StateMachine State UserData where smLoad Menu = loadMenu (smClean Menu >> smLoad InGame) - smLoad InGame = loadGame (smClean InGame >> smLoad Menu) + smLoad InGame = loadGame (smClean InGame >> smLoad Menu) (smClean InGame >> smLoad InGame) smUpdate Menu = updateMenu diff --git a/src/Types.hs b/src/Types.hs index 4f424bf..4ec6ede 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -37,7 +37,7 @@ data Pew = Pew { pPos :: V2 Float , pVel :: V2 Float , pTTL :: Double - } + } deriving (Eq) data Haskelloid = Haskelloid { hPos :: V2 Float