-- | Hacks that haven't found their home yet.
module Game.LambdaHack.Common.Misc
  ( 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 qualified Data.Char as Char
import           Data.Int (Int64)
import qualified Data.Map as M
import qualified NLP.Miniutter.English as MU
import           System.Directory (getAppUserDataDirectory)
import           System.Environment (getProgName)
import           System.IO.Unsafe (unsafePerformIO)

-- | 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 = $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") ]
            -- 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 parts :: [Part]
parts =
  let repetitions :: [[Part]]
repetitions = [Part] -> [[Part]]
forall a. Eq a => [a] -> [[a]]
group [Part]
parts
      f :: [Part] -> (Part, Person)
f [] = [Char] -> (Part, Person)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Part, Person)) -> [Char] -> (Part, Person)
forall a b. (a -> b) -> a -> b
$ "empty group" [Char] -> [Part] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [Part]
parts
      f [part :: 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
        [] -> [Char] -> Person
forall a. HasCallStack => [Char] -> a
error ([Char] -> Person) -> [Char] -> Person
forall a b. (a -> b) -> a -> b
$ "empty cars" [Char] -> [Part] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`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)

-- | 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 [Char]
appDataDir = do
  [Char]
progName <- IO [Char]
getProgName
  let name :: [Char]
name = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
Char.isAlphaNum [Char]
progName
  [Char] -> IO [Char]
getAppUserDataDirectory [Char]
name

xM :: Int -> Int64
xM :: Int -> Int64
xM k :: Int
k = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
`div` 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

-- 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