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 }