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 (fromString) import Control.Monad import Control.Concurrent.MVar -- internal imports import Types import Util loadAdjust :: UserData -> Action -> Controller -> Affection () -> Affection () loadAdjust ud sub contr switchBack = do let Subsystems _ _ _ j _ = subsystems ud uu1 <- partSubscribe j (joyListener ud switchBack) void $ liftIO $ swapMVar (state ud) (Menu (Adjust sub contr)) void $ liftIO $ swapMVar (uuid ud) [uu1] joyListener :: UserData -> Affection () -> JoystickMessage -> Affection () joyListener ud switchBack message = do curState <- liftIO $ readMVar (state ud) trans <- liftIO $ readMVar (translation ud) case message of MsgJoystickAxis _ _ axis val -> do let 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 let (Menu (Adjust cact (Joystick _))) = curState act = case cact of ActUp _ -> ActUp 1 ActDown _ -> ActDown 1 ActLeft _ -> ActLeft 1 ActRight _ -> ActRight 1 x -> A.log A.Error (fromString (show x) <> " is a non-movement action!") (error "*dies*") k = fst <$> find (\(_, v) -> v == act) (M.assocs tmap) void $ liftIO $ swapMVar (translation ud) (JoyTranslation $ M.insert (AxisAction (fromIntegral axis) align) act $ if isJust k then M.delete (fromJust k) tmap else tmap ) fullClean ud switchBack _ -> return () MsgJoystickButton _ _ but SDL.JoyButtonPressed -> do case trans of JoyTranslation tmap -> do case curState 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) void $ liftIO $ swapMVar (translation ud) (JoyTranslation $ M.insert (ButtonAction but SDL.JoyButtonPressed) act $ if isJust k then M.delete (fromJust k) tmap else tmap ) _ -> return () fullClean ud switchBack x -> A.log A.Error (fromString (show x) <> " is a non-joystick translation!") (error "*dies*") _ -> return () drawAdjust :: Context -> Affection () drawAdjust ctx = do liftIO $ do 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