    -- | Screen frames and animations.
    module Game.LambdaHack.Client.UI.Frontend.Common
      ( RawFrontend(..)
      , startupBound, createRawFrontend, resetChanKey, saveKMP
      , modifierTranslate
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Concurrent
    import qualified Control.Concurrent.STM as STM

    import           Game.LambdaHack.Client.UI.Content.Screen
    import           Game.LambdaHack.Client.UI.Frame
    import           Game.LambdaHack.Client.UI.Key (KMP (..))
    import qualified Game.LambdaHack.Client.UI.Key as K
    import           Game.LambdaHack.Client.UI.PointUI
    import           Game.LambdaHack.Common.Misc

    -- | Raw frontend definition. The minimal closed set of values that need
    -- to depend on the specifics of the chosen frontend.
    data RawFrontend = RawFrontend
      { RawFrontend -> SingleFrame -> IO ()
    fdisplay     :: SingleFrame -> IO ()
      , RawFrontend -> IO ()
    fshutdown    :: IO ()
      , RawFrontend -> MVar ()
    fshowNow     :: MVar ()
      , RawFrontend -> TQueue KMP
    fchanKey     :: STM.TQueue KMP
      , RawFrontend -> IO ()
    fprintScreen :: IO ()
      , RawFrontend -> ScreenContent
    fcoscreen    :: ScreenContent
      }

    -- | Start up a frontend on a bound thread.
    --
    -- In fact, it is started on the very main thread, via a hack, because
    -- apparently some SDL backends are not thread-safe
    -- (<https://wiki.libsdl.org/FAQDevelopment>;
    -- "this should only be run in the thread that initialized the video subsystem,
    -- and for extra safety, you should consider only doing those things
    -- on the main thread in any case")
    -- and at least the newer OS X obtusely requires the main thread, see
    -- https://github.com/AllureOfTheStars/Allure/issues/79
    -- In case any other exotic architecture requires the main thread,
    -- we make the hack the default for all (on frontends that require a bound
    -- thread, e.g., SLD2).
    startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend
    startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend
    startupBound MVar RawFrontend -> IO ()
    k = do
      rfMVar <- IO (MVar RawFrontend)
    forall a. IO (MVar a)
    newEmptyMVar
      putMVar workaroundOnMainThreadMVar $ k rfMVar
      -- The following would run frontend on a bound thread, but it's not enough:
      -- a <- asyncBound $ k rfMVar
      -- link a
      takeMVar rfMVar

    createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO ()
                      -> IO RawFrontend
    createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO () -> IO RawFrontend
    createRawFrontend ScreenContent
    fcoscreen SingleFrame -> IO ()
    fdisplay IO ()
    fshutdown = do
      -- Set up the channel for keyboard input.
      fchanKey <- STM (TQueue KMP) -> IO (TQueue KMP)
    forall a. STM a -> IO a
    STM.atomically STM (TQueue KMP)
    forall a. STM (TQueue a)
    STM.newTQueue
      -- Create the session record.
      fshowNow <- newEmptyMVar
      return $! RawFrontend
        { fdisplay
        , fshutdown
        , fshowNow
        , fchanKey
        , fprintScreen = return ()  -- dummy, except for SDL2
        , fcoscreen
        }

    -- | Empty the keyboard channel.
    resetChanKey :: STM.TQueue KMP -> IO ()
    resetChanKey :: TQueue KMP -> IO ()
    resetChanKey TQueue KMP
    fchanKey = do
      res <- STM (Maybe KMP) -> IO (Maybe KMP)
    forall a. STM a -> IO a
    STM.atomically (STM (Maybe KMP) -> IO (Maybe KMP))
    -> STM (Maybe KMP) -> IO (Maybe KMP)
    forall a b. (a -> b) -> a -> b
    $ TQueue KMP -> STM (Maybe KMP)
    forall a. TQueue a -> STM (Maybe a)
    STM.tryReadTQueue TQueue KMP
    fchanKey
      when (isJust res) $ resetChanKey fchanKey

    saveKMP :: RawFrontend -> K.Modifier -> K.Key -> PointUI -> IO ()
    saveKMP :: RawFrontend -> Modifier -> Key -> PointUI -> IO ()
    saveKMP !RawFrontend
    rf !Modifier
    modifier !Key
    key !PointUI
    kmpPointer = do
      -- Instantly show any frame waiting for display.
      IO (Maybe ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MVar () -> IO (Maybe ())
    forall a. MVar a -> IO (Maybe a)
    tryTakeMVar (MVar () -> IO (Maybe ())) -> MVar () -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ RawFrontend -> MVar ()
    fshowNow RawFrontend
    rf
      let kmp :: KMP
    kmp = KMP{kmpKeyMod :: KM
    kmpKeyMod = K.KM{Modifier
    Key
    modifier :: Modifier
    key :: Key
    key :: Key
    modifier :: Modifier
    ..}, PointUI
    kmpPointer :: PointUI
    kmpPointer :: PointUI
    kmpPointer}
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Key
    key Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    K.DeadKey) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        -- Store the key in the channel.
        STM () -> IO ()
    forall a. STM a -> IO a
    STM.atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TQueue KMP -> KMP -> STM ()
    forall a. TQueue a -> a -> STM ()
    STM.writeTQueue (RawFrontend -> TQueue KMP
    fchanKey RawFrontend
    rf) KMP
    kmp

    -- | Translates modifiers to our own encoding.
    modifierTranslate :: Bool -> Bool -> Bool -> Bool -> K.Modifier
    modifierTranslate :: Bool -> Bool -> Bool -> Bool -> Modifier
    modifierTranslate Bool
    modCtrl Bool
    modShift Bool
    modAlt Bool
    modMeta
      | (Bool
    modAlt Bool -> Bool -> Bool
    || Bool
    modMeta) Bool -> Bool -> Bool
    && Bool
    modShift = Modifier
    K.AltShift
      | Bool
    modAlt Bool -> Bool -> Bool
    || Bool
    modMeta = Modifier
    K.Alt
      | Bool
    modCtrl Bool -> Bool -> Bool
    && Bool
    modShift = Modifier
    K.ControlShift
      | Bool
    modCtrl = Modifier
    K.Control
      | Bool
    modShift = Modifier
    K.Shift
      | Bool
    otherwise = Modifier
    K.NoModifier