112 lines
3.9 KiB
Haskell
112 lines
3.9 KiB
Haskell
module Menu.Adjust where
|
|
|
|
import Affection as A
|
|
|
|
import qualified SDL
|
|
|
|
import NanoVG
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import qualified Data.Set as S
|
|
import Data.List (find)
|
|
import Data.Maybe (fromJust, isJust)
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
import Util
|
|
|
|
loadAdjust :: Action -> Controller -> Affection UserData () -> Affection UserData ()
|
|
loadAdjust sub contr switchBack = do
|
|
ud <- getAffection
|
|
let Subsystems w m k j t = subsystems ud
|
|
uu1 <- partSubscribe j (joyListener switchBack)
|
|
putAffection ud
|
|
{ state = Menu (Adjust sub contr)
|
|
, uuid = [ uu1 ]
|
|
}
|
|
|
|
joyListener :: Affection UserData () -> JoystickMessage -> Affection UserData ()
|
|
joyListener switchBack (MsgJoystickAxis _ _ axis val) = do
|
|
ud <- getAffection
|
|
liftIO $ logIO A.Debug ("switching " ++ show (state ud) ++ " to " ++ show axis)
|
|
let trans = translation ud
|
|
align
|
|
| val > 0 = AxisPositive
|
|
| val < 0 = AxisNegative
|
|
| otherwise = A.log A.Error "Can not assign neitral axis align" (error "*dies*")
|
|
case trans of
|
|
JoyTranslation tmap -> do
|
|
case state ud of
|
|
Menu (Adjust (ActUp s) (Joystick _)) -> do
|
|
let k = fst <$> find (\(_, v) -> v == ActUp 1) (M.assocs tmap)
|
|
putAffection ud
|
|
{ translation = JoyTranslation $
|
|
M.insert (AxisAction (fromIntegral axis) align) (ActUp 1) $
|
|
if isJust k then M.delete (fromJust k) (tmap) else tmap
|
|
}
|
|
Menu (Adjust (ActDown s) (Joystick _)) -> do
|
|
let k = fst <$> find (\(_, v) -> v == ActDown 1) (M.assocs tmap)
|
|
putAffection ud
|
|
{ translation = JoyTranslation $
|
|
M.insert (AxisAction (fromIntegral axis) align) (ActDown 1) $
|
|
if isJust k then M.delete (fromJust k) (tmap) else tmap
|
|
}
|
|
Menu (Adjust (ActLeft s) (Joystick _)) -> do
|
|
let k = fst <$> find (\(_, v) -> v == ActLeft 1) (M.assocs tmap)
|
|
putAffection ud
|
|
{ translation = JoyTranslation $
|
|
M.insert (AxisAction (fromIntegral axis) align) (ActLeft 1) $
|
|
if isJust k then M.delete (fromJust k) (tmap) else tmap
|
|
}
|
|
Menu (Adjust (ActRight s) (Joystick _)) -> do
|
|
let k = fst <$> find (\(_, v) -> v == ActRight 1) (M.assocs tmap)
|
|
putAffection ud
|
|
{ translation = JoyTranslation $
|
|
M.insert (AxisAction (fromIntegral axis) align) (ActRight 1) $
|
|
if isJust k then M.delete (fromJust k) (tmap) else tmap
|
|
}
|
|
fullClean
|
|
switchBack
|
|
_ -> return ()
|
|
joyListener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
|
|
ud <- getAffection
|
|
case translation ud of
|
|
JoyTranslation tmap -> do
|
|
case state ud of
|
|
Menu (Adjust (ActUp _) (Joystick _)) -> return ()
|
|
Menu (Adjust (ActDown _) (Joystick _)) -> return ()
|
|
Menu (Adjust (ActLeft _) (Joystick _)) -> return ()
|
|
Menu (Adjust (ActRight _) (Joystick _)) -> return ()
|
|
Menu (Adjust (act) (Joystick _)) -> do
|
|
let k = fst <$> find (\(_, v) -> v == act) (M.assocs tmap)
|
|
putAffection ud
|
|
{ translation = JoyTranslation $
|
|
M.insert (ButtonAction but SDL.JoyButtonPressed) act $
|
|
if isJust k then M.delete (fromJust k) tmap else tmap
|
|
}
|
|
_ -> return ()
|
|
fullClean
|
|
switchBack
|
|
joyListener _ _ = return ()
|
|
|
|
drawAdjust :: Affection UserData ()
|
|
drawAdjust = do
|
|
ud <- getAffection
|
|
liftIO $ do
|
|
let ctx = nano ud
|
|
save ctx
|
|
beginPath ctx
|
|
roundedRect ctx 440 310 400 100 10
|
|
strokeWidth ctx 5
|
|
strokeColor ctx (rgb 255 255 255)
|
|
fillColor ctx (rgb 255 255 255)
|
|
closePath ctx
|
|
stroke ctx
|
|
fill ctx
|
|
fontSize ctx 50
|
|
fontFace ctx "bedstead"
|
|
textAlign ctx (S.fromList [AlignCenter, AlignTop])
|
|
fillColor ctx (rgb 0 0 0)
|
|
textBox ctx 440 310 400 "Enter new movement ..."
|
|
restore ctx
|