menu looks good

This commit is contained in:
nek0 2017-12-19 17:30:44 +01:00
parent bc8cf3cd8c
commit 27179fd225
6 changed files with 46 additions and 17 deletions

View file

@ -25,17 +25,18 @@ import Types
toR :: Double -> Double toR :: Double -> Double
toR deg = deg * pi / 180 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) wrapAround (V2 nx ny) width = (V2 nnx nny)
where where
nnx nnx
| nx > 800 = nx - (800 + width) | nx > 800 + half = nx - (800 + width)
| nx < -width = nx + 800 + width | nx < -half = nx + 800 + width
| otherwise = nx | otherwise = nx
nny nny
| ny > 600 = ny - (600 + width) | ny > 600 + half = ny - (600 + width)
| ny < -width = ny + 600 + width | ny < -half = ny + 600 + width
| otherwise = ny | otherwise = ny
half = width / 2
newHaskelloids :: Image -> Affection UserData [Haskelloid] newHaskelloids :: Image -> Affection UserData [Haskelloid]
newHaskelloids img = liftIO $ mapM (\_ -> do newHaskelloids img = liftIO $ mapM (\_ -> do
@ -58,7 +59,9 @@ newHaskelloids img = liftIO $ mapM (\_ -> do
updateHaskelloid :: Double -> Haskelloid -> Haskelloid updateHaskelloid :: Double -> Haskelloid -> Haskelloid
updateHaskelloid dsec has = updateHaskelloid dsec has =
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 , hRot = hRot has + hPitch has * sec
} }
where where
@ -75,8 +78,9 @@ drawImage ctx img pos dim rot alpha = do
let (V2 x y) = fmap CFloat pos let (V2 x y) = fmap CFloat pos
(V2 w h) = fmap CFloat dim (V2 w h) = fmap CFloat dim
save ctx save ctx
translate ctx x y translate ctx (x + (w/2)) (y + (h/2))
rotate ctx (degToRad $ CFloat rot) rotate ctx (degToRad $ CFloat rot)
translate ctx (-(w/2)) (-(h/2))
sPaint <- imagePattern ctx 0 0 w h 0 img (CFloat alpha) sPaint <- imagePattern ctx 0 0 w h 0 img (CFloat alpha)
beginPath ctx beginPath ctx
rect ctx 0 0 w h rect ctx 0 0 w h
@ -111,4 +115,6 @@ drawSpinner ctx x y cr ct = do
drawHaskelloid :: Haskelloid -> Affection UserData () drawHaskelloid :: Haskelloid -> Affection UserData ()
drawHaskelloid (Haskelloid pos _ rot _ div img) = do drawHaskelloid (Haskelloid pos _ rot _ div img) = do
ctx <- nano <$> getAffection 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))

View file

@ -41,6 +41,11 @@ load = do
when (isNothing mshipImage) $ do when (isNothing mshipImage) $ do
logIO Error "Failed loading image assets" logIO Error "Failed loading image assets"
exitFailure 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 subs <- Subsystems
<$> (return . Window =<< newTVarIO []) <$> (return . Window =<< newTVarIO [])
<*> (return . Keyboard =<< newTVarIO []) <*> (return . Keyboard =<< newTVarIO [])
@ -56,6 +61,7 @@ load = do
, state = Menu , state = Menu
, fade = FadeIn 1 , fade = FadeIn 1
, nano = nvgCtx , nano = nvgCtx
, font = fromJust mfont
, subsystems = subs , subsystems = subs
} }

View file

@ -48,8 +48,9 @@ update sec = do
handle :: [SDL.EventPayload] -> Affection UserData () handle :: [SDL.EventPayload] -> Affection UserData ()
handle e = do handle e = do
ud <- getAffection (Subsystems w k) <- subsystems <$> getAffection
smEvent (state ud) e _ <- consumeSDLEvents w =<< consumeSDLEvents k e
return ()
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do

View file

@ -6,13 +6,14 @@ import qualified SDL
import Debug.Trace import Debug.Trace
import Data.Maybe import Data.Maybe
import qualified Data.Set as S
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M import qualified Data.Map as M
import NanoVG hiding (V2(..)) import NanoVG hiding (V2(..), V4(..))
import Linear import Linear
@ -77,5 +78,21 @@ drawMenu :: Affection UserData ()
drawMenu = do drawMenu = do
ud <- getAffection ud <- getAffection
mapM_ drawHaskelloid (haskelloids ud) 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 -- t <- getElapsedTime
-- liftIO $ drawSpinner (nano ud) 100 100 100 t -- liftIO $ drawSpinner (nano ud) 100 100 100 t

View file

@ -26,10 +26,8 @@ instance StateMachine State UserData where
-- smUpdate InGame sec = updateGame sec -- smUpdate InGame sec = updateGame sec
smEvent Menu = handleMenuEvent (return ()) -- (smLoad InGame)
-- smEvent InGame = handleGameEvent
smDraw Menu = drawMenu smDraw Menu = drawMenu
-- smDraw InGame = drawGame -- smDraw InGame = drawGame
smEvent _ _ = return ()

View file

@ -20,6 +20,7 @@ data UserData = UserData
, state :: State , state :: State
, fade :: MenuFade , fade :: MenuFade
, nano :: Context , nano :: Context
, font :: Font
, subsystems :: Subsystems , subsystems :: Subsystems
} }