{-# LANGUAGE DeriveGeneric #-}
-- | UI aspects of actors.
module Game.LambdaHack.Client.UI.ActorUI
  ( ActorUI(..), ActorDictUI
  , keySelected, partActor, partPronoun, tryFindActor, tryFindHeroK
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import           GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Definition.Color as Color

data ActorUI = ActorUI
  { ActorUI -> Char
bsymbol  :: Char         -- ^ individual map symbol
  , ActorUI -> Text
bname    :: Text         -- ^ individual name
  , ActorUI -> Text
bpronoun :: Text         -- ^ individual pronoun
  , ActorUI -> Color
bcolor   :: Color.Color  -- ^ individual map color
  }
  deriving (Int -> ActorUI -> ShowS
[ActorUI] -> ShowS
ActorUI -> String
(Int -> ActorUI -> ShowS)
-> (ActorUI -> String) -> ([ActorUI] -> ShowS) -> Show ActorUI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActorUI] -> ShowS
$cshowList :: [ActorUI] -> ShowS
show :: ActorUI -> String
$cshow :: ActorUI -> String
showsPrec :: Int -> ActorUI -> ShowS
$cshowsPrec :: Int -> ActorUI -> ShowS
Show, ActorUI -> ActorUI -> Bool
(ActorUI -> ActorUI -> Bool)
-> (ActorUI -> ActorUI -> Bool) -> Eq ActorUI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActorUI -> ActorUI -> Bool
$c/= :: ActorUI -> ActorUI -> Bool
== :: ActorUI -> ActorUI -> Bool
$c== :: ActorUI -> ActorUI -> Bool
Eq, (forall x. ActorUI -> Rep ActorUI x)
-> (forall x. Rep ActorUI x -> ActorUI) -> Generic ActorUI
forall x. Rep ActorUI x -> ActorUI
forall x. ActorUI -> Rep ActorUI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActorUI x -> ActorUI
$cfrom :: forall x. ActorUI -> Rep ActorUI x
Generic)

instance Binary ActorUI

type ActorDictUI = EM.EnumMap ActorId ActorUI

keySelected :: (ActorId, Actor, ActorUI)
            -> (Bool, Bool, Bool, Char, Color.Color, ActorId)
keySelected :: (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected (aid :: ActorId
aid, Actor{Int64
bhp :: Actor -> Int64
bhp :: Int64
bhp, Watchfulness
bwatch :: Actor -> Watchfulness
bwatch :: Watchfulness
bwatch}, ActorUI{Char
bsymbol :: Char
bsymbol :: ActorUI -> Char
bsymbol, Color
bcolor :: Color
bcolor :: ActorUI -> Color
bcolor}) =
  (Int64
bhp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0, Watchfulness
bwatch Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep, Char
bsymbol Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '@', Char
bsymbol, Color
bcolor, ActorId
aid)

-- | The part of speech describing the actor.
partActor :: ActorUI -> MU.Part
partActor :: ActorUI -> Part
partActor b :: ActorUI
b = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bname ActorUI
b

-- | The part of speech containing the actor's pronoun.
partPronoun :: ActorUI -> MU.Part
partPronoun :: ActorUI -> Part
partPronoun b :: ActorUI
b = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
b

tryFindActor :: State -> (ActorId -> Actor -> Bool) -> Maybe (ActorId, Actor)
tryFindActor :: State -> (ActorId -> Actor -> Bool) -> Maybe (ActorId, Actor)
tryFindActor s :: State
s p :: ActorId -> Actor -> Bool
p = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ActorId -> Actor -> Bool) -> (ActorId, Actor) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ActorId -> Actor -> Bool
p) ([(ActorId, Actor)] -> Maybe (ActorId, Actor))
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Actor -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ActorId Actor -> [(ActorId, Actor)])
-> EnumMap ActorId Actor -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ActorId Actor
sactorD State
s

tryFindHeroK :: ActorDictUI -> FactionId -> Int -> State
             -> Maybe (ActorId, Actor)
tryFindHeroK :: ActorDictUI -> FactionId -> Int -> State -> Maybe (ActorId, Actor)
tryFindHeroK d :: ActorDictUI
d fid :: FactionId
fid k :: Int
k s :: State
s =
  let c :: Char
c | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0          = '@'
        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = Int -> Char
Char.intToDigit Int
k
        | Bool
otherwise       = ' '  -- no hero with such symbol
  in State -> (ActorId -> Actor -> Bool) -> Maybe (ActorId, Actor)
tryFindActor State
s (\aid :: ActorId
aid body :: Actor
body ->
       Bool -> (ActorUI -> Bool) -> Maybe ActorUI -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) (Char -> Bool) -> (ActorUI -> Char) -> ActorUI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorUI -> Char
bsymbol) (ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid ActorDictUI
d)
       Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid)