    {-# LANGUAGE DeriveGeneric #-}
    -- | Hacks that haven't found their home yet.
    module Game.LambdaHack.Common.Misc
      ( FontDefinition(..), HintingMode(..), FontSet(..)
      , makePhrase, makeSentence, squashedWWandW
      , appDataDir
      , xM, xD, minusM, minusM1, minusM2, oneM, tenthM
      , show64With2
      , workaroundOnMainThreadMVar
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Concurrent
    import           Control.DeepSeq
    import           Data.Binary
    import qualified Data.Char as Char
    import           Data.Int (Int64)
    import qualified Data.Map as M
    import           GHC.Generics (Generic)
    import qualified NLP.Miniutter.English as MU
    import           System.Directory (getAppUserDataDirectory)
    import           System.Environment (getProgName)
    import           System.IO.Unsafe (unsafePerformIO)

    data FontDefinition =
        FontProportional Text Int HintingMode  -- ^ filename, size, hinting mode
      | FontMonospace Text Int HintingMode
      | FontMapScalable Text Int HintingMode Int  -- ^ extra cell extension
      | FontMapBitmap Text Int  -- ^ size ignored for bitmap fonts and no hinting
      deriving (Int -> FontDefinition -> ShowS
    [FontDefinition] -> ShowS
    FontDefinition -> String
    (Int -> FontDefinition -> ShowS)
    -> (FontDefinition -> String)
    -> ([FontDefinition] -> ShowS)
    -> Show FontDefinition
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FontDefinition -> ShowS
    showsPrec :: Int -> FontDefinition -> ShowS
    $cshow :: FontDefinition -> String
    show :: FontDefinition -> String
    $cshowList :: [FontDefinition] -> ShowS
    showList :: [FontDefinition] -> ShowS
    Show, FontDefinition -> FontDefinition -> Bool
    (FontDefinition -> FontDefinition -> Bool)
    -> (FontDefinition -> FontDefinition -> Bool) -> Eq FontDefinition
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FontDefinition -> FontDefinition -> Bool
    == :: FontDefinition -> FontDefinition -> Bool
    $c/= :: FontDefinition -> FontDefinition -> Bool
    /= :: FontDefinition -> FontDefinition -> Bool
    Eq, ReadPrec [FontDefinition]
    ReadPrec FontDefinition
    Int -> ReadS FontDefinition
    ReadS [FontDefinition]
    (Int -> ReadS FontDefinition)
    -> ReadS [FontDefinition]
    -> ReadPrec FontDefinition
    -> ReadPrec [FontDefinition]
    -> Read FontDefinition
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS FontDefinition
    readsPrec :: Int -> ReadS FontDefinition
    $creadList :: ReadS [FontDefinition]
    readList :: ReadS [FontDefinition]
    $creadPrec :: ReadPrec FontDefinition
    readPrec :: ReadPrec FontDefinition
    $creadListPrec :: ReadPrec [FontDefinition]
    readListPrec :: ReadPrec [FontDefinition]
    Read, (forall x. FontDefinition -> Rep FontDefinition x)
    -> (forall x. Rep FontDefinition x -> FontDefinition)
    -> Generic FontDefinition
    forall x. Rep FontDefinition x -> FontDefinition
    forall x. FontDefinition -> Rep FontDefinition x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. FontDefinition -> Rep FontDefinition x
    from :: forall x. FontDefinition -> Rep FontDefinition x
    $cto :: forall x. Rep FontDefinition x -> FontDefinition
    to :: forall x. Rep FontDefinition x -> FontDefinition
    Generic)

    instance NFData FontDefinition

    instance Binary FontDefinition

    data HintingMode =
        HintingHeavy  -- ^ current libfreetype6 default, thin, large letter spacing
      | HintingLight  -- ^ mimics OTF, blurry, thick, tight tracking, accurate shape
      deriving (Int -> HintingMode -> ShowS
    [HintingMode] -> ShowS
    HintingMode -> String
    (Int -> HintingMode -> ShowS)
    -> (HintingMode -> String)
    -> ([HintingMode] -> ShowS)
    -> Show HintingMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HintingMode -> ShowS
    showsPrec :: Int -> HintingMode -> ShowS
    $cshow :: HintingMode -> String
    show :: HintingMode -> String
    $cshowList :: [HintingMode] -> ShowS
    showList :: [HintingMode] -> ShowS
    Show, HintingMode -> HintingMode -> Bool
    (HintingMode -> HintingMode -> Bool)
    -> (HintingMode -> HintingMode -> Bool) -> Eq HintingMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HintingMode -> HintingMode -> Bool
    == :: HintingMode -> HintingMode -> Bool
    $c/= :: HintingMode -> HintingMode -> Bool
    /= :: HintingMode -> HintingMode -> Bool
    Eq, ReadPrec [HintingMode]
    ReadPrec HintingMode
    Int -> ReadS HintingMode
    ReadS [HintingMode]
    (Int -> ReadS HintingMode)
    -> ReadS [HintingMode]
    -> ReadPrec HintingMode
    -> ReadPrec [HintingMode]
    -> Read HintingMode
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS HintingMode
    readsPrec :: Int -> ReadS HintingMode
    $creadList :: ReadS [HintingMode]
    readList :: ReadS [HintingMode]
    $creadPrec :: ReadPrec HintingMode
    readPrec :: ReadPrec HintingMode
    $creadListPrec :: ReadPrec [HintingMode]
    readListPrec :: ReadPrec [HintingMode]
    Read, (forall x. HintingMode -> Rep HintingMode x)
    -> (forall x. Rep HintingMode x -> HintingMode)
    -> Generic HintingMode
    forall x. Rep HintingMode x -> HintingMode
    forall x. HintingMode -> Rep HintingMode x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. HintingMode -> Rep HintingMode x
    from :: forall x. HintingMode -> Rep HintingMode x
    $cto :: forall x. Rep HintingMode x -> HintingMode
    to :: forall x. Rep HintingMode x -> HintingMode
    Generic)

    instance NFData HintingMode

    instance Binary HintingMode

    data FontSet = FontSet
      { FontSet -> Text
    fontMapScalable :: Text
      , FontSet -> Text
    fontMapBitmap   :: Text
      , FontSet -> Text
    fontPropRegular :: Text
      , FontSet -> Text
    fontPropBold    :: Text
      , FontSet -> Text
    fontMono        :: Text }
      deriving (Int -> FontSet -> ShowS
    [FontSet] -> ShowS
    FontSet -> String
    (Int -> FontSet -> ShowS)
    -> (FontSet -> String) -> ([FontSet] -> ShowS) -> Show FontSet
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FontSet -> ShowS
    showsPrec :: Int -> FontSet -> ShowS
    $cshow :: FontSet -> String
    show :: FontSet -> String
    $cshowList :: [FontSet] -> ShowS
    showList :: [FontSet] -> ShowS
    Show, FontSet -> FontSet -> Bool
    (FontSet -> FontSet -> Bool)
    -> (FontSet -> FontSet -> Bool) -> Eq FontSet
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FontSet -> FontSet -> Bool
    == :: FontSet -> FontSet -> Bool
    $c/= :: FontSet -> FontSet -> Bool
    /= :: FontSet -> FontSet -> Bool
    Eq, ReadPrec [FontSet]
    ReadPrec FontSet
    Int -> ReadS FontSet
    ReadS [FontSet]
    (Int -> ReadS FontSet)
    -> ReadS [FontSet]
    -> ReadPrec FontSet
    -> ReadPrec [FontSet]
    -> Read FontSet
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS FontSet
    readsPrec :: Int -> ReadS FontSet
    $creadList :: ReadS [FontSet]
    readList :: ReadS [FontSet]
    $creadPrec :: ReadPrec FontSet
    readPrec :: ReadPrec FontSet
    $creadListPrec :: ReadPrec [FontSet]
    readListPrec :: ReadPrec [FontSet]
    Read, (forall x. FontSet -> Rep FontSet x)
    -> (forall x. Rep FontSet x -> FontSet) -> Generic FontSet
    forall x. Rep FontSet x -> FontSet
    forall x. FontSet -> Rep FontSet x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. FontSet -> Rep FontSet x
    from :: forall x. FontSet -> Rep FontSet x
    $cto :: forall x. Rep FontSet x -> FontSet
    to :: forall x. Rep FontSet x -> FontSet
    Generic)

    instance NFData FontSet

    instance Binary FontSet

    -- | Re-exported English phrase creation functions, applied to our custom
    -- irregular word sets.
    makePhrase, makeSentence :: [MU.Part] -> Text
    makePhrase :: [Part] -> Text
    makePhrase = Irregular -> [Part] -> Text
    MU.makePhrase Irregular
    irregular
    makeSentence :: [Part] -> Text
    makeSentence = Irregular -> [Part] -> Text
    MU.makeSentence Irregular
    irregular

    irregular :: MU.Irregular
    irregular :: Irregular
    irregular = MU.Irregular
      { irrPlural :: Map Text Text
    irrPlural =
          [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
            [ (Text
    "merchandise", Text
    "merchandise")
            , (Text
    "Merchandise", Text
    "Merchandise")
            , (Text
    "stomach", Text
    "stomachs") ]
                -- this is both countable and uncountable, but I use it here
                -- only as uncountable, do I overwrite the default
          Map Text Text -> Map Text Text -> Map Text Text
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union` Irregular -> Map Text Text
    MU.irrPlural Irregular
    MU.defIrregular
      , irrIndefinite :: Map Text Text
    irrIndefinite = Irregular -> Map Text Text
    MU.irrIndefinite Irregular
    MU.defIrregular
      }

    -- | Apply the @WWandW@ constructor, first representing repetitions
    -- as @CardinalWs@.
    -- The parts are not sorted, only grouped, to keep the order.
    -- The internal structure of speech parts is compared, not their string
    -- rendering, so some coincidental clashes are avoided (and code is simpler).
    squashedWWandW :: [MU.Part] -> (MU.Part, MU.Person)
    squashedWWandW :: [Part] -> (Part, Person)
    squashedWWandW [Part]
    parts =
      let repetitions :: [[Part]]
    repetitions = [Part] -> [[Part]]
    forall a. Eq a => [a] -> [[a]]
    group [Part]
    parts
          f :: [Part] -> (Part, Person)
    f [] = String -> (Part, Person)
    forall a. HasCallStack => String -> a
    error (String -> (Part, Person)) -> String -> (Part, Person)
    forall a b. (a -> b) -> a -> b
    $ String
    "empty group" String -> [Part] -> String
    forall v. Show v => String -> v -> String
    `showFailure` [Part]
    parts
          f [Part
    part] = (Part
    part, Person
    MU.Sg3rd)  -- avoid prefixing hero names with "a"
          f l :: [Part]
    l@(Part
    part : [Part]
    _) = (Int -> Part -> Part
    MU.CardinalWs ([Part] -> Int
    forall a. [a] -> Int
    length [Part]
    l) Part
    part, Person
    MU.PlEtc)
          cars :: [(Part, Person)]
    cars = ([Part] -> (Part, Person)) -> [[Part]] -> [(Part, Person)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Part] -> (Part, Person)
    f [[Part]]
    repetitions
          person :: Person
    person = case [(Part, Person)]
    cars of
            [] -> String -> Person
    forall a. HasCallStack => String -> a
    error (String -> Person) -> String -> Person
    forall a b. (a -> b) -> a -> b
    $ String
    "empty cars" String -> [Part] -> String
    forall v. Show v => String -> v -> String
    `showFailure` [Part]
    parts
            [(Part
    _, Person
    person1)] -> Person
    person1
            [(Part, Person)]
    _ -> Person
    MU.PlEtc
      in ([Part] -> Part
    MU.WWandW ([Part] -> Part) -> [Part] -> Part
    forall a b. (a -> b) -> a -> b
    $ ((Part, Person) -> Part) -> [(Part, Person)] -> [Part]
    forall a b. (a -> b) -> [a] -> [b]
    map (Part, Person) -> Part
    forall a b. (a, b) -> a
    fst [(Part, Person)]
    cars, Person
    person)

    -- | Personal data directory for the game. Depends on the OS and the game,
    -- e.g., for LambdaHack under Linux it's @~\/.LambdaHack\/@.
    appDataDir :: IO FilePath
    appDataDir :: IO String
    appDataDir = do
      progName <- IO String
    getProgName
      let name = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    Char.isAlphaNum String
    progName
      getAppUserDataDirectory name

    -- | Multiplies by a million.
    xM :: Int -> Int64
    xM :: Int -> Int64
    xM Int
    k = forall target source. From source target => source -> target
    into @Int64 Int
    k Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    1000000

    -- | Multiplies by a million, double precision.
    xD :: Double -> Double
    xD :: Double -> Double
    xD Double
    k = Double
    k Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    1000000

    minusM, minusM1, minusM2, oneM, tenthM :: Int64
    minusM :: Int64
    minusM = Int -> Int64
    xM (-Int
    1)
    minusM1 :: Int64
    minusM1 = Int -> Int64
    xM (-Int
    1) Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64
    1
    minusM2 :: Int64
    minusM2 = Int -> Int64
    xM (-Int
    1) Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64
    2
    oneM :: Int64
    oneM = Int -> Int64
    xM Int
    1
    tenthM :: Int64
    tenthM = Int64
    100000

    show64With2 :: Int64 -> Text
    show64With2 :: Int64 -> Text
    show64With2 Int64
    n =
      let k :: Int64
    k = Int64
    100 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    n Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `divUp` Int64
    oneM
          l :: Int64
    l = Int64
    k Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int64
    100
          x :: Int64
    x = Int64
    k Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64
    l Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    100
          y :: Int64
    y = Int64
    x Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int64
    10
      in Int64 -> Text
    forall a. Show a => a -> Text
    tshow Int64
    l
         Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> if | Int64
    x Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    0 -> Text
    ""
               | Int64
    x Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    y Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    10 -> Text
    "." Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int64 -> Text
    forall a. Show a => a -> Text
    tshow Int64
    y
               | Int64
    x Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int64
    10 -> Text
    ".0" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int64 -> Text
    forall a. Show a => a -> Text
    tshow Int64
    x
               | Bool
    otherwise -> Text
    "." Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int64 -> Text
    forall a. Show a => a -> Text
    tshow Int64
    x

    -- Global variable for passing the action to run on main thread, if any.
    workaroundOnMainThreadMVar :: MVar (IO ())
    {-# NOINLINE workaroundOnMainThreadMVar #-}
    workaroundOnMainThreadMVar :: MVar (IO ())
    workaroundOnMainThreadMVar = IO (MVar (IO ())) -> MVar (IO ())
    forall a. IO a -> a
    unsafePerformIO IO (MVar (IO ()))
    forall a. IO (MVar a)
    newEmptyMVar