76 lines
1.7 KiB
Haskell
76 lines
1.7 KiB
Haskell
module Menu where
|
|
|
|
import Affection as A
|
|
|
|
import qualified SDL
|
|
|
|
import NanoVG
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe (isNothing)
|
|
|
|
import Control.Monad (when)
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
|
|
loadMenu :: Affection UserData ()
|
|
loadMenu = do
|
|
ud <- getAffection
|
|
ad <- get
|
|
let (Subsystems _ m _ j _) = subsystems ud
|
|
uu1 <- partSubscribe j joystickConnect
|
|
uu2 <- partSubscribe j joyDisconnect
|
|
putAffection ud
|
|
{ uuid = [ uu1, uu2 ]
|
|
, state = Menu
|
|
}
|
|
|
|
joystickConnect :: JoystickMessage -> Affection UserData ()
|
|
joystickConnect msg = do
|
|
ud <- getAffection
|
|
when (isNothing $ joystick ud) $ do
|
|
mjoy <- joystickAutoConnect msg
|
|
maybe (return ()) (\joy -> do
|
|
ident <- liftIO $ fromIntegral <$> SDL.getJoystickID joy
|
|
liftIO $ logIO A.Debug $ "Joystick connected: " ++ show ident
|
|
putAffection ud
|
|
{ joystick = Just joy
|
|
, translation = defaultTranslation
|
|
}
|
|
) mjoy
|
|
|
|
joyDisconnect :: JoystickMessage -> Affection UserData ()
|
|
joyDisconnect msg = do
|
|
ud <- getAffection
|
|
maybe (return ()) (\joy -> do
|
|
njoys <- joystickAutoDisconnect [joy] msg
|
|
when (null njoys) $ do
|
|
liftIO $ logIO A.Debug $ "Joystick disconnected"
|
|
putAffection ud
|
|
{ joystick = Nothing
|
|
}
|
|
) (joystick ud)
|
|
|
|
updateMenu :: Double -> Affection UserData ()
|
|
updateMenu dt = return ()
|
|
|
|
drawMenu :: Affection UserData ()
|
|
drawMenu = do
|
|
ud <- getAffection
|
|
liftIO $ do
|
|
let ctx = nano ud
|
|
controller = joystick ud
|
|
save ctx
|
|
beginPath ctx
|
|
paint <- imagePattern ctx 600 620 80 80 0 (assetIcons ud M.!
|
|
if isNothing controller
|
|
then IconContrBlue
|
|
else IconContrGreen
|
|
) 1
|
|
rect ctx 600 620 80 80
|
|
fillPaint ctx paint
|
|
fill ctx
|
|
restore ctx
|