{-# LANGUAGE DeriveGeneric #-}
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
| FontMonospace Text Int HintingMode
| FontMapScalable Text Int HintingMode Int
| FontMapBitmap Text Int
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
showList :: [FontDefinition] -> ShowS
$cshowList :: [FontDefinition] -> ShowS
show :: FontDefinition -> String
$cshow :: FontDefinition -> String
showsPrec :: Int -> FontDefinition -> ShowS
$cshowsPrec :: Int -> FontDefinition -> ShowS
Show, FontDefinition -> FontDefinition -> Bool
(FontDefinition -> FontDefinition -> Bool)
-> (FontDefinition -> FontDefinition -> Bool) -> Eq FontDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontDefinition -> FontDefinition -> Bool
$c/= :: FontDefinition -> FontDefinition -> Bool
== :: FontDefinition -> FontDefinition -> Bool
$c== :: 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
readListPrec :: ReadPrec [FontDefinition]
$creadListPrec :: ReadPrec [FontDefinition]
readPrec :: ReadPrec FontDefinition
$creadPrec :: ReadPrec FontDefinition
readList :: ReadS [FontDefinition]
$creadList :: ReadS [FontDefinition]
readsPrec :: Int -> ReadS FontDefinition
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep FontDefinition x -> FontDefinition
$cfrom :: forall x. FontDefinition -> Rep FontDefinition x
Generic)
instance NFData FontDefinition
instance Binary FontDefinition
data HintingMode =
HintingHeavy
| HintingLight
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
showList :: [HintingMode] -> ShowS
$cshowList :: [HintingMode] -> ShowS
show :: HintingMode -> String
$cshow :: HintingMode -> String
showsPrec :: Int -> HintingMode -> ShowS
$cshowsPrec :: Int -> HintingMode -> ShowS
Show, HintingMode -> HintingMode -> Bool
(HintingMode -> HintingMode -> Bool)
-> (HintingMode -> HintingMode -> Bool) -> Eq HintingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HintingMode -> HintingMode -> Bool
$c/= :: HintingMode -> HintingMode -> Bool
== :: HintingMode -> HintingMode -> Bool
$c== :: 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
readListPrec :: ReadPrec [HintingMode]
$creadListPrec :: ReadPrec [HintingMode]
readPrec :: ReadPrec HintingMode
$creadPrec :: ReadPrec HintingMode
readList :: ReadS [HintingMode]
$creadList :: ReadS [HintingMode]
readsPrec :: Int -> ReadS HintingMode
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep HintingMode x -> HintingMode
$cfrom :: forall x. HintingMode -> Rep HintingMode x
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
showList :: [FontSet] -> ShowS
$cshowList :: [FontSet] -> ShowS
show :: FontSet -> String
$cshow :: FontSet -> String
showsPrec :: Int -> FontSet -> ShowS
$cshowsPrec :: Int -> FontSet -> ShowS
Show, FontSet -> FontSet -> Bool
(FontSet -> FontSet -> Bool)
-> (FontSet -> FontSet -> Bool) -> Eq FontSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSet -> FontSet -> Bool
$c/= :: FontSet -> FontSet -> Bool
== :: FontSet -> FontSet -> Bool
$c== :: 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
readListPrec :: ReadPrec [FontSet]
$creadListPrec :: ReadPrec [FontSet]
readPrec :: ReadPrec FontSet
$creadPrec :: ReadPrec FontSet
readList :: ReadS [FontSet]
$creadList :: ReadS [FontSet]
readsPrec :: Int -> ReadS FontSet
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep FontSet x -> FontSet
$cfrom :: forall x. FontSet -> Rep FontSet x
Generic)
instance NFData FontSet
instance Binary FontSet
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 = $WIrregular :: Map Text Text -> Map Text Text -> 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
[ ("merchandise", "merchandise")
, ("Merchandise", "Merchandise")
, ("stomach", "stomachs") ]
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
}
squashedWWandW :: [MU.Part] -> (MU.Part, MU.Person)
squashedWWandW :: [Part] -> (Part, Person)
squashedWWandW parts :: [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
$ "empty group" String -> [Part] -> String
forall v. Show v => String -> v -> String
`showFailure` [Part]
parts
f [part :: Part
part] = (Part
part, Person
MU.Sg3rd)
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
$ "empty cars" String -> [Part] -> String
forall v. Show v => String -> v -> String
`showFailure` [Part]
parts
[(_, person1 :: Person
person1)] -> Person
person1
_ -> 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)
appDataDir :: IO FilePath
appDataDir :: IO String
appDataDir = do
String
progName <- IO String
getProgName
let name :: String
name = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
Char.isAlphaNum String
progName
String -> IO String
getAppUserDataDirectory String
name
xM :: Int -> Int64
xM :: Int -> Int64
xM k :: Int
k = Int -> Int64
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast Int
k Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* 1000000
xD :: Double -> Double
xD :: Double -> Double
xD k :: Double
k = Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1000000
minusM, minusM1, minusM2, oneM, tenthM :: Int64
minusM :: Int64
minusM = Int -> Int64
xM (-1)
minusM1 :: Int64
minusM1 = Int -> Int64
xM (-1) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 1
minusM2 :: Int64
minusM2 = Int -> Int64
xM (-1) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 2
oneM :: Int64
oneM = Int -> Int64
xM 1
tenthM :: Int64
tenthM = 100000
show64With2 :: Int64 -> Text
show64With2 :: Int64 -> Text
show64With2 n :: Int64
n =
let k :: Int64
k = 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` 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
* 100
y :: Int64
y = Int64
x Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 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
== 0 -> ""
| Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* 10 -> "." 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
< 10 -> ".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
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
x
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