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.Common.Misc
import Game.LambdaHack.Common.Point
data RawFrontend = RawFrontend
{ fdisplay :: SingleFrame -> IO ()
, fshutdown :: IO ()
, fshowNow :: MVar ()
, fchanKey :: STM.TQueue KMP
, fprintScreen :: IO ()
, fcoscreen :: ScreenContent
}
startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend
startupBound k = do
rfMVar <- newEmptyMVar
putMVar workaroundOnMainThreadMVar $ k rfMVar
takeMVar rfMVar
createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO ()
-> IO RawFrontend
createRawFrontend fcoscreen fdisplay fshutdown = do
fchanKey <- STM.atomically STM.newTQueue
fshowNow <- newEmptyMVar
return $! RawFrontend
{ fdisplay
, fshutdown
, fshowNow
, fchanKey
, fprintScreen = return ()
, fcoscreen
}
resetChanKey :: STM.TQueue KMP -> IO ()
resetChanKey fchanKey = do
res <- STM.atomically $ STM.tryReadTQueue fchanKey
when (isJust res) $ resetChanKey fchanKey
saveKMP :: RawFrontend -> K.Modifier -> K.Key -> Point -> IO ()
saveKMP !rf !modifier !key !kmpPointer = do
void $ tryTakeMVar $ fshowNow rf
let kmp = KMP{kmpKeyMod = K.KM{..}, kmpPointer}
unless (key == K.DeadKey) $
STM.atomically $ STM.writeTQueue (fchanKey rf) kmp
modifierTranslate :: Bool -> Bool -> Bool -> Bool -> K.Modifier
modifierTranslate modCtrl modShift modAlt modMeta
| modCtrl = K.Control
| modAlt || modMeta = K.Alt
| modShift = K.Shift
| otherwise = K.NoModifier