module Game.LambdaHack.Grammar
(
Verb, Object
, capitalize, pluralise, addIndefinite, conjugate
, objectItemCheat, objectItem, objectActor, capActor
, actorVerb, actorVerbItem, actorVerbActor, actorVerbExtraItem
, lookAt
) where
import Data.Char
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.List as L
import Data.Maybe
import Game.LambdaHack.Utils.Assert
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
irregularPlural :: M.Map String String
irregularPlural = M.fromList
[ ("canto" , "cantos")
, ("homo " , "homos")
, ("photo" , "photos")
, ("zero" , "zeros")
, ("piano" , "pianos")
, ("portico", "porticos")
, ("pro" , "pros")
, ("quarto" , "quartos")
, ("kimono" , "kimonos")
, ("calf" , "calves")
, ("leaf" , "leaves")
, ("knife" , "knives")
, ("life" , "lives")
, ("dwarf" , "dwarves")
, ("hoof" , "hooves")
, ("elf" , "elves")
, ("staff" , "staves")
, ("child" , "children")
, ("foot" , "feet")
, ("goose" , "geese")
, ("louse" , "lice")
, ("man" , "men")
, ("mouse" , "mice")
, ("tooth" , "teeth")
, ("woman" , "women")
]
noPlural :: S.Set String
noPlural = S.fromList
[ "buffalo"
, "deer"
, "moose"
, "sheep"
, "bison"
, "salmon"
, "pike"
, "trout"
, "swine"
, "aircraft"
, "watercraft"
, "spacecraft"
, "hovercraft"
, "information"
]
vowel :: Char -> Bool
vowel l = l `elem` "aeio"
compound :: Bool -> (String -> String) -> String -> String
compound modifyFirst f phrase =
let rev | modifyFirst = reverse
| otherwise = id
in case rev $ words phrase of
[] -> assert `failure` "compound: no words"
word : rest -> unwords $ rev $ f word : rest
suffixS :: String -> String
suffixS = compound False singleSuffixS
singleSuffixS :: String -> String
singleSuffixS 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"
pluralise :: Object -> Object
pluralise = compound True singlePluralise
singlePluralise :: Object -> Object
singlePluralise word =
if word `S.member` noPlural
then word
else case M.lookup word irregularPlural of
Just plural -> plural
Nothing -> suffixS word
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 (pluralise obj)
objectItemCheat :: Kind.Ops ItemKind -> Bool -> State -> Item -> Object
objectItemCheat coitem@Kind.Ops{okind} cheat 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 =
let known = name ++ addSpace eff ++ addSpace pwr
flavour = getFlavour coitem (sflavour state) ik
obscured = flavourToName flavour ++ " " ++ name
in if identified
then known
else if cheat
then flavourToName flavour ++ " " ++ known
else obscured
in makeObject (jcount i) adj (iname kind)
objectItem :: Kind.Ops ItemKind -> State -> Item -> Object
objectItem coitem = objectItemCheat coitem False
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 -> String
actorVerb coactor a v extra =
let cactor = capActor coactor a
verb = conjugate cactor v
ending | null extra = "."
| otherwise = " " ++ extra ++ "."
in cactor ++ " " ++ verb ++ ending
actorVerbItem :: Kind.COps -> State -> Actor -> Verb -> Item -> String
-> String
actorVerbItem Kind.COps{coactor, coitem} state a v i extra =
let ending | null extra = ""
| otherwise = " " ++ extra
in actorVerb coactor a v $
objectItem coitem state i ++ ending
actorVerbActor :: Kind.Ops ActorKind -> Actor -> Verb -> Actor -> String
-> String
actorVerbActor coactor a v b extra =
let ending | null extra = ""
| otherwise = " " ++ extra
in actorVerb coactor a v $
objectActor coactor b ++ ending
actorVerbExtraItem :: Kind.COps -> State -> Actor -> Verb -> String
-> Item -> String -> String
actorVerbExtraItem Kind.COps{coactor, coitem} state a v extra1 i extra2 =
assert (not $ null extra1) $
let ending | null extra2 = ""
| otherwise = " " ++ extra2
in actorVerb coactor a v $
extra1 ++ " " ++ objectItem coitem state i ++ ending
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 "
isd = case is of
[] -> ""
[i] -> prefixSee ++ objectItem coitem s i ++ "."
[i,j] -> prefixSee ++ objectItem coitem s i ++ " and "
++ objectItem coitem s j ++ "."
_ | detailed -> "Objects:"
_ -> "Objects here."