module Game.LambdaHack.Grammar
(
Verb, Object
, capitalize, suffixS, addIndefinite
, objectItem, objectActor, capActor
, actorVerb, actorVerbExtra, actorVerbItemExtra
, actorVerbActorExtra, actorVerbExtraItemExtra
, lookAt
) where
import Data.Char
import qualified Data.Set as S
import qualified Data.List as L
import Data.Maybe
import Game.LambdaHack.Point
import Game.LambdaHack.Item
import Game.LambdaHack.Actor
import Game.LambdaHack.Level
import Game.LambdaHack.State
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Effect
import Game.LambdaHack.Flavour
import qualified Game.LambdaHack.Kind as Kind
type Verb = String
type Object = String
vowel :: Char -> Bool
vowel l = l `elem` "aeio"
suffixS :: String -> String
suffixS word = case L.reverse word of
'h' : 'c' : _ -> word ++ "es"
'h' : 's' : _ -> word ++ "es"
'i' : 's' : _ -> word ++ "es"
's' : _ -> word ++ "es"
'z' : _ -> word ++ "es"
'x' : _ -> word ++ "es"
'j' : _ -> word ++ "es"
'o' : l : _ | not (vowel l) -> init word ++ "es"
'y' : l : _ | not (vowel l) -> init word ++ "ies"
_ -> word ++ "s"
conjugate :: String -> Verb -> Verb
conjugate "you" "be" = "are"
conjugate "You" "be" = "are"
conjugate _ "be" = "is"
conjugate "you" verb = verb
conjugate "You" verb = verb
conjugate _ verb = suffixS verb
capitalize :: Object -> Object
capitalize [] = []
capitalize (c : cs) = toUpper c : cs
addIndefinite :: Object -> Object
addIndefinite b = case b of
c : _ | vowel c -> "an " ++ b
_ -> "a " ++ b
makeObject :: Int -> (Object -> Object) -> Object -> Object
makeObject 1 f obj = addIndefinite $ f obj
makeObject n f obj = show n ++ " " ++ f (suffixS obj)
objectItem :: Kind.Ops ItemKind -> State -> Item -> Object
objectItem coitem@Kind.Ops{okind} state i =
let ik = jkind i
kind = okind ik
identified = L.length (iflavour kind) == 1 ||
ik `S.member` sdisco state
addSpace s = if s == "" then "" else " " ++ s
eff = effectToSuffix (ieffect kind)
pwr = if jpower i == 0 then "" else "(+" ++ show (jpower i) ++ ")"
adj name = if identified
then name ++ addSpace eff ++ addSpace pwr
else let flavour = getFlavour coitem (sflavour state) ik
in flavourToName flavour ++ " " ++ name
in makeObject (jcount i) adj (iname kind)
objectActor :: Kind.Ops ActorKind -> Actor -> Object
objectActor Kind.Ops{oname} a =
fromMaybe (oname $ bkind a) (bname a)
capActor :: Kind.Ops ActorKind -> Actor -> Object
capActor coactor x = capitalize $ objectActor coactor x
actorVerb :: Kind.Ops ActorKind -> Actor -> Verb -> String
actorVerb coactor a v =
let cactor = capActor coactor a
verb = conjugate cactor v
in cactor ++ " " ++ verb ++ "."
actorVerbExtra :: Kind.Ops ActorKind -> Actor -> Verb -> String-> String
actorVerbExtra coactor a v extra =
L.init (actorVerb coactor a v) ++ " " ++ extra ++ "."
actorVerbItemExtra :: Kind.COps -> State -> Actor -> Verb -> Item -> String
-> String
actorVerbItemExtra Kind.COps{coactor, coitem} state a v i extra =
actorVerbExtra coactor a v $
objectItem coitem state i ++ extra
actorVerbActorExtra :: Kind.Ops ActorKind -> Actor -> Verb -> Actor -> String
-> String
actorVerbActorExtra coactor a v b extra =
actorVerbExtra coactor a v $
objectActor coactor b ++ extra
actorVerbExtraItemExtra :: Kind.COps -> State -> Actor -> Verb -> String
-> Item -> String -> String
actorVerbExtraItemExtra Kind.COps{coactor, coitem} state a v extra1 i extra2 =
actorVerbExtra coactor a v $
extra1 ++ " " ++ objectItem coitem state i ++ extra2
lookAt :: Kind.COps
-> Bool
-> Bool
-> State
-> Level
-> Point
-> String
-> String
lookAt Kind.COps{coitem, cotile=Kind.Ops{oname}} detailed canSee s lvl loc msg
| detailed =
let tile = lvl `rememberAt` loc
name = capitalize $ oname tile
in name ++ ". " ++ msg ++ isd
| otherwise = msg ++ isd
where
is = lvl `rememberAtI` loc
prefixSee = if canSee then "You see " else "You remember "
prefixThere = if canSee
then "There are several objects here"
else "You remember several objects here"
isd = case is of
[] -> ""
[i] -> prefixSee ++ objectItem coitem s i ++ "."
[i,j] -> prefixSee ++ objectItem coitem s i ++ " and "
++ objectItem coitem s j ++ "."
_ -> prefixThere ++ if detailed then ":" else "."