module Game.LambdaHack.Frontend.Std
(
FrontendSession
, fdisplay, fpromptGetKey
, frontendName, startup
) where
import qualified Data.ByteString.Char8 as BS
import Data.Char (chr, ord)
import qualified Data.List as L
import Data.Text.Encoding (encodeUtf8)
import qualified System.IO as SIO
import Game.LambdaHack.Common.Animation (DebugModeCli (..), SingleFrame (..))
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Key as K
data FrontendSession = FrontendSession
{ sdebugCli :: !DebugModeCli
}
frontendName :: String
frontendName = "std"
startup :: DebugModeCli -> (FrontendSession -> IO ()) -> IO ()
startup sdebugCli k = k FrontendSession{..}
fdisplay :: FrontendSession
-> Bool
-> Maybe SingleFrame
-> IO ()
fdisplay _ _ Nothing = return ()
fdisplay _ _ (Just SingleFrame{..}) =
let chars = L.map (BS.pack . L.map Color.acChar) sfLevel
bs = [encodeUtf8 sfTop, BS.empty] ++ chars ++ [encodeUtf8 sfBottom, BS.empty]
in mapM_ BS.putStrLn bs
nextEvent :: FrontendSession -> IO K.KM
nextEvent FrontendSession{sdebugCli=DebugModeCli{snoMore}} =
if snoMore then return K.escKey
else do
l <- BS.hGetLine SIO.stdin
let c = case BS.uncons l of
Nothing -> '\n'
Just (hd, _) -> hd
return $! keyTranslate c
fpromptGetKey :: FrontendSession -> SingleFrame -> IO K.KM
fpromptGetKey sess frame = do
fdisplay sess True $ Just frame
nextEvent sess
keyTranslate :: Char -> K.KM
keyTranslate e = (\(key, modifier) -> K.KM {..}) $
case e of
'\ESC' -> (K.Esc, K.NoModifier)
'\n' -> (K.Return, K.NoModifier)
'\r' -> (K.Return, K.NoModifier)
' ' -> (K.Space, K.NoModifier)
'\t' -> (K.Tab, K.NoModifier)
c | ord '\^A' <= ord c && ord c <= ord '\^Z' ->
(K.Char $ chr $ ord c ord '\^A' + ord 'a', K.Control)
| c `elem` ['1'..'9'] -> (K.KP c, K.NoModifier)
| otherwise -> (K.Char c, K.NoModifier)