tracer/src/Menu/Adjust.hs

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 -> Affection UserData () -> Affection UserData ()
loadAdjust sub switchBack = do
  ud <- getAffection
  let Subsystems w m k j t = subsystems ud
  uu1 <- partSubscribe j (listener switchBack)
  putAffection ud
    { state = Menu (Adjust sub)
    , uuid = [ uu1 ]
    }

listener :: Affection UserData () -> JoystickMessage -> Affection UserData ()
listener switchBack (MsgJoystickAxis _ _ axis val) = do
  ud <- getAffection
  liftIO $ logIO A.Debug ("switching " ++ show (state ud) ++ " to " ++ show axis)
  case state ud of
    Menu (Adjust (UpDown s)) -> do
      let k = fst <$> find (\(_, v) -> v == UpDown 1 || v == UpDown (-1)) (M.assocs $ translation ud)
      putAffection ud
        { translation =
          M.insert (AxisAction $ fromIntegral axis) (UpDown (fromIntegral $ -signum val)) $
            if isJust k then M.delete (fromJust k) (translation ud) else translation ud
        }
    Menu (Adjust (LeftRight s)) -> do
      let k = fst <$> find (\(_, v) -> v == LeftRight 1 || v == LeftRight (-1)) (M.assocs $ translation ud)
      putAffection ud
        { translation =
          M.insert (AxisAction $ fromIntegral axis) (LeftRight (fromIntegral $ signum val)) $
            if isJust k then M.delete (fromJust k) (translation ud) else translation ud
        }
  fullClean
  switchBack
listener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
  ud <- getAffection
  case state ud of
    Menu (Adjust (UpDown s)) -> return ()
    Menu (Adjust (LeftRight s)) -> return ()
    Menu (Adjust (act)) -> do
      let k = fst <$> find (\(_, v) -> v == act) (M.assocs $ translation ud)
      putAffection ud
        { translation =
          M.insert (ButtonAction but SDL.JoyButtonPressed) act $
            if isJust k then M.delete (fromJust k) (translation ud) else translation ud
        }
    _ -> return ()
  fullClean
  switchBack
listener _ _ = 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