<commit_before>-- | Text frontend based on Gtk.
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Game.LambdaHack.Client.Action.Frontend.Gtk
  ( -- * Session data type for the frontend
    FrontendSession
    -- * The output and input operations
  , display, nextEvent, promptGetAnyKey
    -- * Frontend administration tools
  , frontendName, startup
  ) where

import Control.Concurrent
import Control.Exception (finally)
import Control.Monad
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as BS
import Data.IORef
import qualified Data.List as L
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Graphics.UI.Gtk hiding (Point)
import System.Time

import Game.LambdaHack.Client.Animation (SingleFrame (..))
import qualified Game.LambdaHack.Client.Key as K (KM, Modifier (..),
                                                  keyTranslate)
import qualified Game.LambdaHack.Color as Color
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Utils.LQueue

data FrameState =
    FPushed  -- frames stored in a queue, to be drawn in equal time intervals
      { fpushed :: !(LQueue (Maybe GtkFrame))  -- ^ screen output channel
      , fshown  :: !GtkFrame                   -- ^ last full frame shown
      }
  | FSet  -- a single frame stored, to be drawn when a keypress is requested
      { fsetFrame :: !(Maybe GtkFrame)         -- ^ frame to draw at input key
      }
  | FNone  -- no frames stored

-- | Session data maintained by the frontend.
data FrontendSession = FrontendSession
  { sview       :: !TextView                    -- ^ the widget to draw to
  , stags       :: !(M.Map Color.Attr TextTag)  -- ^ text color tags for fg/bg
  , schanKey    :: !(Chan K.KM)                 -- ^ channel for keyboard input
  , sframeState :: !(MVar FrameState)           -- ^ state of the frame machine
  , slastFull   :: !(IORef (GtkFrame, Bool))
      -- ^ most recent full (not empty, not repeated) frame received
      -- and if any empty frame followed it
  }

data GtkFrame = GtkFrame
  { gfChar :: !BS.ByteString
  , gfAttr :: ![[TextTag]]
  }
  deriving Eq

dummyFrame :: GtkFrame
dummyFrame = GtkFrame BS.empty []

-- | Remove all but the last element of the frame queue.
-- The kept last element ensures that slastFull is not invalidated.
trimQueue :: FrontendSession -> IO ()
trimQueue FrontendSession{sframeState} = do
  fs <- takeMVar sframeState
  case fs of
    FPushed{..} ->
      putMVar sframeState FPushed{fpushed = trimLQueue fpushed, ..}
    _ ->
      putMVar sframeState fs

-- | The name of the frontend.
frontendName :: String
frontendName = "gtk"

-- | Spawns the gtk input and output thread, which spawns all the other
-- required threads. We create a separate thread for gtk to minimize
-- communication with the heavy main thread. The other threads have to be
-- spawned after gtk is initialized, because they call @postGUIAsync@,
-- and need @sview@ and @stags@.
startup :: String -> (FrontendSession -> IO ()) -> IO ()
startup configFont k = do
  mv <- newEmptyMVar
  -- Fork the gtk input and output thread.
  -- TODO: when GHC changes, make sure GTK is still faster on its own thread.
  void $ forkOS (runGtk configFont k `finally` putMVar mv ())
  takeMVar mv

-- | Sets up and starts the main GTK loop providing input and output.
runGtk :: String ->  (FrontendSession -> IO ()) -> IO ()
runGtk configFont k = do
  -- Init GUI.
  unsafeInitGUIForThreadedRTS
  -- Text attributes.
  ttt <- textTagTableNew
  stags <- fmap M.fromList $
             mapM (\ ak -> do
                      tt <- textTagNew Nothing
                      textTagTableAdd ttt tt
                      doAttr tt ak
                      return (ak, tt))<commit_msg>Do not spawn a GTK thread, since Windows forces us to use bound threads<commit_after>-- | Text frontend based on Gtk.
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Game.LambdaHack.Client.Action.Frontend.Gtk
  ( -- * Session data type for the frontend
    FrontendSession
    -- * The output and input operations
  , display, nextEvent, promptGetAnyKey
    -- * Frontend administration tools
  , frontendName, startup
  ) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as BS
import Data.IORef
import qualified Data.List as L
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Graphics.UI.Gtk hiding (Point)
import System.Time

import Game.LambdaHack.Client.Animation (SingleFrame (..))
import qualified Game.LambdaHack.Client.Key as K (KM, Modifier (..),
                                                  keyTranslate)
import qualified Game.LambdaHack.Color as Color
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Utils.LQueue

data FrameState =
    FPushed  -- frames stored in a queue, to be drawn in equal time intervals
      { fpushed :: !(LQueue (Maybe GtkFrame))  -- ^ screen output channel
      , fshown  :: !GtkFrame                   -- ^ last full frame shown
      }
  | FSet  -- a single frame stored, to be drawn when a keypress is requested
      { fsetFrame :: !(Maybe GtkFrame)         -- ^ frame to draw at input key
      }
  | FNone  -- no frames stored

-- | Session data maintained by the frontend.
data FrontendSession = FrontendSession
  { sview       :: !TextView                    -- ^ the widget to draw to
  , stags       :: !(M.Map Color.Attr TextTag)  -- ^ text color tags for fg/bg
  , schanKey    :: !(Chan K.KM)                 -- ^ channel for keyboard input
  , sframeState :: !(MVar FrameState)           -- ^ state of the frame machine
  , slastFull   :: !(IORef (GtkFrame, Bool))
      -- ^ most recent full (not empty, not repeated) frame received
      -- and if any empty frame followed it
  }

data GtkFrame = GtkFrame
  { gfChar :: !BS.ByteString
  , gfAttr :: ![[TextTag]]
  }
  deriving Eq

dummyFrame :: GtkFrame
dummyFrame = GtkFrame BS.empty []

-- | Remove all but the last element of the frame queue.
-- The kept last element ensures that slastFull is not invalidated.
trimQueue :: FrontendSession -> IO ()
trimQueue FrontendSession{sframeState} = do
  fs <- takeMVar sframeState
  case fs of
    FPushed{..} ->
      putMVar sframeState FPushed{fpushed = trimLQueue fpushed, ..}
    _ ->
      putMVar sframeState fs

-- | The name of the frontend.
frontendName :: String
frontendName = "gtk"

-- | Starts GTK. The other threads have to be spawned
-- after gtk is initialized, because they call @postGUIAsync@,
-- and need @sview@ and @stags@. Because of Windows, GTK needs to be
-- on a bound thread, so we can't avoid the communication overhead
-- of bound threads, so there's no point spawning a separate thread for GTK.
startup :: String -> (FrontendSession -> IO ()) -> IO ()
startup configFont k = runGtk configFont k

-- | Sets up and starts the main GTK loop providing input and output.
runGtk :: String ->  (FrontendSession -> IO ()) -> IO ()
runGtk configFont k = do
  -- Init GUI.
  unsafeInitGUIForThreadedRTS
  -- Text attributes.
  ttt <- textTagTableNew
  stags <- fmap M.fromList $
             mapM (\ ak -> do
                      tt <- textTagNew Nothing
                      textTagTableAdd ttt tt
                      doAttr tt ak
                      return (ak, tt))
{'fraction_non_alphanumeric': 0.09248008640475226, 'fraction_numerical': 0.0005400297016335898, 'mean_word_length': 2.539417104634496, 'pattern_counts': {'":': 0, '<': 12, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5386292', 'n_tokens_mistral': 2182, 'n_tokens_neox': 2143, 'n_words': 798}