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
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
}
startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend
startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend
startupBound k :: MVar RawFrontend -> IO ()
k = do
MVar RawFrontend
rfMVar <- IO (MVar RawFrontend)
forall a. IO (MVar a)
newEmptyMVar
MVar (IO ()) -> IO () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
workaroundOnMainThreadMVar (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar RawFrontend -> IO ()
k MVar RawFrontend
rfMVar
MVar RawFrontend -> IO RawFrontend
forall a. MVar a -> IO a
takeMVar MVar RawFrontend
rfMVar
createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO ()
-> IO RawFrontend
createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO () -> IO RawFrontend
createRawFrontend fcoscreen :: ScreenContent
fcoscreen fdisplay :: SingleFrame -> IO ()
fdisplay fshutdown :: IO ()
fshutdown = do
TQueue KMP
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
MVar ()
fshowNow <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
RawFrontend -> IO RawFrontend
forall (m :: * -> *) a. Monad m => a -> m a
return (RawFrontend -> IO RawFrontend) -> RawFrontend -> IO RawFrontend
forall a b. (a -> b) -> a -> b
$! $WRawFrontend :: (SingleFrame -> IO ())
-> IO ()
-> MVar ()
-> TQueue KMP
-> IO ()
-> ScreenContent
-> RawFrontend
RawFrontend
{ SingleFrame -> IO ()
fdisplay :: SingleFrame -> IO ()
fdisplay :: SingleFrame -> IO ()
fdisplay
, IO ()
fshutdown :: IO ()
fshutdown :: IO ()
fshutdown
, MVar ()
fshowNow :: MVar ()
fshowNow :: MVar ()
fshowNow
, TQueue KMP
fchanKey :: TQueue KMP
fchanKey :: TQueue KMP
fchanKey
, fprintScreen :: IO ()
fprintScreen = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, ScreenContent
fcoscreen :: ScreenContent
fcoscreen :: ScreenContent
fcoscreen
}
resetChanKey :: STM.TQueue KMP -> IO ()
resetChanKey :: TQueue KMP -> IO ()
resetChanKey fchanKey :: TQueue KMP
fchanKey = do
Maybe KMP
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe KMP -> Bool
forall a. Maybe a -> Bool
isJust Maybe KMP
res) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue KMP -> IO ()
resetChanKey TQueue KMP
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
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 = $WKMP :: KM -> PointUI -> KMP
KMP{kmpKeyMod :: KM
kmpKeyMod = $WKM :: Modifier -> Key -> KM
K.KM{..}, 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
$
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
modifierTranslate :: Bool -> Bool -> Bool -> Bool -> K.Modifier
modifierTranslate :: Bool -> Bool -> Bool -> Bool -> Modifier
modifierTranslate modCtrl :: Bool
modCtrl modShift :: Bool
modShift modAlt :: Bool
modAlt modMeta :: 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