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) import Data.String -- 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 " <> fromString (show $ state ud) <> " to " <> fromString (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