bumped module Menu.Adjust to affection 0.0.0.10

This commit is contained in:
nek0 2020-05-05 07:05:59 +02:00
parent 81e16c4428
commit ace1f0ce8c

View file

@ -10,98 +10,74 @@ import qualified Data.Map.Strict as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.List (find) import Data.List (find)
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust)
import Data.String import Data.String (fromString)
import Control.Monad
import Control.Concurrent.MVar
-- internal imports -- internal imports
import Types import Types
import Util import Util
loadAdjust :: Action -> Controller -> Affection UserData () -> Affection UserData () loadAdjust :: UserData -> Action -> Controller -> Affection () -> Affection ()
loadAdjust sub contr switchBack = do loadAdjust ud sub contr switchBack = do
ud <- getAffection let Subsystems _ _ _ j _ = subsystems ud
let Subsystems w m k j t = subsystems ud uu1 <- partSubscribe j (joyListener ud switchBack)
uu1 <- partSubscribe j (joyListener switchBack) void $ liftIO $ swapMVar (state ud) (Menu (Adjust sub contr))
putAffection ud void $ liftIO $ swapMVar (uuid ud) [uu1]
{ state = Menu (Adjust sub contr)
, uuid = [ uu1 ]
}
joyListener :: Affection UserData () -> JoystickMessage -> Affection UserData () joyListener :: UserData -> Affection () -> JoystickMessage -> Affection ()
joyListener switchBack (MsgJoystickAxis _ _ axis val) = do joyListener ud switchBack message = do
ud <- getAffection curState <- liftIO $ readMVar (state ud)
liftIO $ logIO trans <- liftIO $ readMVar (translation ud)
A.Debug case message of
("switching " <> MsgJoystickAxis _ _ axis val -> do
fromString (show $ state ud) <> let align
" to " <> | val > 0 = AxisPositive
fromString (show axis) | val < 0 = AxisNegative
) | otherwise = A.log A.Error "Can not assign neitral axis align" (error "*dies*")
let trans = translation ud case trans of
align JoyTranslation tmap -> do
| val > 0 = AxisPositive let (Menu (Adjust cact (Joystick _))) = curState
| val < 0 = AxisNegative act = case cact of
| otherwise = A.log A.Error "Can not assign neitral axis align" (error "*dies*") ActUp _ -> ActUp 1
case trans of ActDown _ -> ActDown 1
JoyTranslation tmap -> do ActLeft _ -> ActLeft 1
case state ud of ActRight _ -> ActRight 1
Menu (Adjust (ActUp s) (Joystick _)) -> do x -> A.log A.Error (fromString (show x) <> " is a non-movement action!") (error "*dies*")
let k = fst <$> find (\(_, v) -> v == ActUp 1) (M.assocs tmap) k = fst <$> find (\(_, v) -> v == act) (M.assocs tmap)
putAffection ud void $ liftIO $ swapMVar (translation ud) (JoyTranslation $
{ translation = JoyTranslation $ M.insert (AxisAction (fromIntegral axis) align) act $
M.insert (AxisAction (fromIntegral axis) align) (ActUp 1) $ if isJust k then M.delete (fromJust k) tmap else tmap
if isJust k then M.delete (fromJust k) (tmap) else tmap )
} fullClean ud
Menu (Adjust (ActDown s) (Joystick _)) -> do switchBack
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 () _ -> return ()
fullClean MsgJoystickButton _ _ but SDL.JoyButtonPressed -> do
switchBack case trans of
joyListener _ _ = return () 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 :: Affection UserData () drawAdjust :: Context -> Affection ()
drawAdjust = do drawAdjust ctx = do
ud <- getAffection
liftIO $ do liftIO $ do
let ctx = nano ud
save ctx save ctx
beginPath ctx beginPath ctx
roundedRect ctx 440 310 400 100 10 roundedRect ctx 440 310 400 100 10