content: {-# LANGUAGE GADTs, KindSignatures, RankNTypes #-}
  -- | Display game data on the screen and receive user input
  -- using one of the available raw frontends and derived operations.
  module Game.LambdaHack.Client.UI.Frontend
    ( -- * Connection and initialization
      FrontReq(..), ChanFrontend(..), chanFrontendIO
      -- * Re-exported part of the raw frontend
    , frontendName
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , FrontSetup, getKey, fchanFrontend, display, defaultMaxFps, microInSec
    , frameTimeoutThread, lazyStartup, nullStartup, seqFrame
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Control.Concurrent
  import           Control.Concurrent.Async
  import qualified Control.Concurrent.STM as STM
  import           Control.Monad.ST.Strict
  import           Data.Kind (Type)
  import qualified Data.Text.IO as T
  import qualified Data.Vector.Generic as G
  import qualified Data.Vector.Unboxed as U
  import           Data.Word
  import           System.IO (hFlush, stdout)
  
  import           Game.LambdaHack.Client.UI.Content.Screen
  import           Game.LambdaHack.Client.UI.Frame
  import           Game.LambdaHack.Client.UI.Frontend.Common
  import qualified Game.LambdaHack.Client.UI.Frontend.Teletype as Teletype
  import           Game.LambdaHack.Client.UI.Key (KMP (..))
  import qualified Game.LambdaHack.Client.UI.Key as K
  import           Game.LambdaHack.Common.ClientOptions
  import qualified Game.LambdaHack.Common.PointArray as PointArray
  import qualified Game.LambdaHack.Definition.Color as Color
  
  #ifdef USE_BROWSER
  import qualified Game.LambdaHack.Client.UI.Frontend.Dom as Chosen
  #else
  import qualified Game.LambdaHack.Client.UI.Frontend.ANSI as ANSI
  import qualified Game.LambdaHack.Client.UI.Frontend.Sdl as Chosen
  #endif
  
  -- | The instructions sent by clients to the raw frontend, indexed
  -- by the returned value.
  data FrontReq :: Type -> Type where
    -- | Show a frame.
    FrontFrame :: Frame -> FrontReq ()
    -- | Perform an explicit delay of the given length.
    FrontDelay :: Int -> FrontReq ()
    -- | Flush frames, display a frame and ask for a keypress.
    FrontKey :: [K.KM] -> Frame -> FrontReq KMP
    -- | Tell if a keypress is pending.
    FrontPressed :: FrontReq Bool
    -- | Discard a single key in the queue, if any.
    FrontDiscardKey :: FrontReq ()
    -- | Discard all keys in the queue.
    FrontResetKeys :: FrontReq ()
    -- | Shut the frontend down.
    FrontShutdown :: FrontReq ()
    -- | Take screenshot.
    FrontPrintScreen :: FrontReq ()
  
  -- | Connection channel between a frontend and a client. Frontend acts
  -- as a server, serving keys, etc., when given frames to display.
  newtype ChanFrontend = ChanFrontend (forall a. FrontReq a -> IO a)
  
  -- | Machinery allocated for an individual frontend at its startup,
  -- unchanged for its lifetime.
  data FrontSetup = FrontSetup
    { fasyncTimeout :: Async ()
    , fdelay        :: MVar Int
    }
  
  -- | Initialize the frontend chosen by the player via client options.
  chanFrontendIO :: ScreenContent -> ClientOptions -> IO ChanFrontend
  chanFrontendIO coscreen soptions = do
    let startup | sfrontendNull soptions = nullStartup coscreen
                | sfrontendLazy soptions = lazyStartup coscreen
  #ifndef REMOVE_TELETYPE
                | sfrontendTeletype soptions = Teletype.startup coscreen
  #endif
  #ifndef USE_BROWSER
                | sfrontendANSI soptions = ANSI.startup coscreen
  #endif
                | otherwise = Chosen.startup coscreen soptions
        maxFps = fromMaybe defaultMaxFps $ smaxFps soptions
        delta = max 1 $ round $ intToDouble microInSec / max 0.000001 maxFps
    rf <- startup
    when (sdbgMsgCli soptions) $ do
      T.hPutStr stdout "Frontend startup up.\n"
        -- hPutStrLn not atomic enough
      hFlush stdout
    fdelay <- newMVar 0
    fasyncTimeout <- async $ frameTimeoutThread delta fdelay rf
    -- Warning: not linking @fasyncTimeout@, so it'd better not crash.
    let fs = FrontSetup{..}
        chanFrontend = fchanFrontend fs rf
    return chanFrontend
  
  -- Display a frame, wait for any of the specified keys (for any key,
  -- if the list is empty). Repeat if an unexpected key received.
  getKey :: FrontSetup -> RawFrontend -> [K.KM] -> Frame -> IO KMP
  getKey fs rf@RawFrontend{fchanKey} keys frame = do
    -- Wait until timeout is up, not to skip the last frame of animation.
    display rf frame
    kmp <- STM.atomically $ STM.readTQueue fchanKey
    if null keys || kmpKeyMod kmp `elem` keys
    then return kmp
    else getKey fs rf keys frame
  
  -- Read UI requests from the client and send them to the frontend,
  fchanFrontend :: FrontSetup -> RawFrontend -> ChanFrontend
  fchanFrontend fs@FrontSetup{..} rf =
    ChanFrontend $ \case
      FrontFrame frontFrame -> display rf frontFrame
      FrontDelay k -> modifyMVar_ fdelay $ return . (+ k)
      FrontKey frontKeyKeys frontKeyFrame ->
        getKey fs rf frontKeyKeys frontKeyFrame
      FrontPressed -> do
        noKeysPending <- STM.atomically $ STM.isEmptyTQueue (fchanKey rf)
        return $! not noKeysPending
      FrontDiscardKey ->
        void $ STM.atomically $ STM.tryReadTQueue (fchanKey rf)
      FrontResetKeys -> resetChanKey (fchanKey rf)
      FrontShutdown -> do
        cancel fasyncTimeout
        -- In case the last frame display is pending:
        void $ tryTakeMVar $ fshowNow rf
        fshutdown rf
      FrontPrintScreen -> fprintScreen rf
  
  display :: RawFrontend -> Frame -> IO ()
  display rf@RawFrontend{fshowNow, fcoscreen=ScreenContent{rwidth, rheight}}
          ((m, upd), (ovProp, ovSquare, ovMono)) = do
    let new :: forall s. ST s (G.Mutable U.Vector s Word32)
        new = do
          v <- unFrameBase m
          unFrameForall upd v
          return v
        singleArray = PointArray.Array rwidth rheight (U.create new)
    putMVar fshowNow () -- 1. wait for permission to display; 3. ack
    fdisplay rf $ SingleFrame singleArray ovProp ovSquare ovMono
  
  defaultMaxFps :: Double
  defaultMaxFps = 24
  
  microInSec :: Int
  microInSec = 1000000
  
  -- This thread is canceled forcefully, because the @threadDelay@
  -- may be much longer than an acceptable shutdown time.
  frameTimeoutThread :: Int -> MVar Int -> RawFrontend -> IO ()
  frameTimeoutThread delta fdelay RawFrontend{..} = do
    let loop = do
          threadDelay delta
          let delayLoop = do
                delay <- readMVar fdelay
                when (delay > 0) $ do
                  threadDelay $ delta * delay
                  modifyMVar_ fdelay $ return . subtract delay
                  delayLoop
          delayLoop
          let showFrameAndRepeatIfKeys = do
                -- @fshowNow@ is full at this point, unless @saveKM@ emptied it,
                -- in which case we wait below until @display@ fills it
                takeMVar fshowNow  -- 2. permit display
                -- @fshowNow@ is ever empty only here, unless @saveKM@ empties it
                readMVar fshowNow  -- 4. wait for ack before starting delay
                -- @fshowNow@ is full at this point
                noKeysPending <- STM.atomically $ STM.isEmptyTQueue fchanKey
                unless noKeysPending $ do
                  void $ swapMVar fdelay 0  -- cancel delays lest they accumulate
                  showFrameAndRepeatIfKeys
          showFrameAndRepeatIfKeys
          loop
    loop
  
  -- | The name of the chosen frontend.
  frontendName :: ClientOptions -> String
  frontendName soptions =
    if | sfrontendNull soptions -> "null test"
       | sfrontendLazy soptions -> "lazy test"
  #ifndef REMOVE_TELETYPE
       | sfrontendTeletype soptions -> Teletype.frontendName
  #endif
  #ifndef USE_BROWSER
       | sfrontendANSI soptions -> ANSI.frontendName
  #endif
       | otherwise -> Chosen.frontendName
  
  lazyStartup :: ScreenContent -> IO RawFrontend
  lazyStartup coscreen = createRawFrontend coscreen (\_ -> return ()) (return ())
  
  nullStartup :: ScreenContent -> IO RawFrontend
  nullStartup coscreen = createRawFrontend coscreen seqFrame (return ())
  
  seqFrame :: SingleFrame -> IO ()
  seqFrame SingleFrame{..} =
    let seqAttr () attr = Color.colorToRGB (Color.fgFromW32 attr)
                          `seq` Color.bgFromW32 attr
                          `seq` Color.charFromW32 attr == ' '
                          `seq` ()
        !_Force1 = PointArray.foldlA' seqAttr () singleArray
        !_Force2 = length singlePropOverlay
        !_Force3 = length singleSquareOverlay
        !_Force4 = length singleMonoOverlay
    in return ()
  