module Game.LambdaHack.Actor
(
ActorId, findHeroName, monsterGenChance
, Actor(..), template, addHp, timeAddFromSpeed, braced
, unoccupied, heroKindId, projectileKindId, actorSpeed
, Target(..)
) where
import Control.Monad
import Data.Binary
import Data.Maybe
import Data.Ratio
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Vector
import Game.LambdaHack.Point
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Kind as Kind
import Game.LambdaHack.Random
import qualified Game.LambdaHack.Config as Config
import Game.LambdaHack.Time
import qualified Game.LambdaHack.Color as Color
data Actor = Actor
{ bkind :: !(Kind.Id ActorKind)
, bsymbol :: !(Maybe Char)
, bname :: !(Maybe String)
, bcolor :: !(Maybe Color.Color)
, bspeed :: !(Maybe Speed)
, bhp :: !Int
, bdir :: !(Maybe (Vector, Int))
, btarget :: Target
, bloc :: !Point
, bletter :: !Char
, btime :: !Time
, bwait :: !Time
, bfaction :: !(Kind.Id FactionKind)
, bproj :: !Bool
}
deriving Show
instance Binary Actor where
put Actor{..} = do
put bkind
put bsymbol
put bname
put bcolor
put bspeed
put bhp
put bdir
put btarget
put bloc
put bletter
put btime
put bwait
put bfaction
put bproj
get = do
bkind <- get
bsymbol <- get
bname <- get
bcolor <- get
bspeed <- get
bhp <- get
bdir <- get
btarget <- get
bloc <- get
bletter <- get
btime <- get
bwait <- get
bfaction <- get
bproj <- get
return Actor{..}
type ActorId = Int
findHeroName :: Config.CP -> Int -> String
findHeroName config n =
let heroName = Config.getOption config "heroes" ("HeroName_" ++ show n)
in fromMaybe ("hero number " ++ show n) heroName
monsterGenChance :: Int -> Int -> Rnd Bool
monsterGenChance depth numMonsters =
chance $ 1%(fromIntegral (30 * (numMonsters depth)) `max` 5)
template :: Kind.Id ActorKind -> Maybe Char -> Maybe String -> Int -> Point
-> Time -> Kind.Id FactionKind -> Bool -> Actor
template bkind bsymbol bname bhp bloc btime bfaction bproj =
let bcolor = Nothing
bspeed = Nothing
btarget = invalidTarget
bdir = Nothing
bletter = 'a'
bwait = timeZero
in Actor{..}
addHp :: Kind.Ops ActorKind -> Int -> Actor -> Actor
addHp Kind.Ops{okind} extra m =
assert (extra >= 0 `blame` extra) $
let maxHP = maxDice (ahp $ okind $ bkind m)
currentHP = bhp m
in if currentHP > maxHP
then m
else m {bhp = min maxHP (currentHP + extra)}
actorSpeed :: Kind.Ops ActorKind -> Actor -> Speed
actorSpeed Kind.Ops{okind} m =
let stockSpeed = aspeed $ okind $ bkind m
in fromMaybe stockSpeed $ bspeed m
timeAddFromSpeed :: Kind.Ops ActorKind -> Actor -> Time -> Time
timeAddFromSpeed coactor m time =
let speed = actorSpeed coactor m
delta = ticksPerMeter speed
in timeAdd time delta
braced :: Actor -> Time -> Bool
braced m time = time < bwait m
unoccupied :: [Actor] -> Point -> Bool
unoccupied actors loc =
all (\ body -> bloc body /= loc) actors
heroKindId :: Kind.Ops ActorKind -> Kind.Id ActorKind
heroKindId Kind.Ops{ouniqGroup} = ouniqGroup "hero"
projectileKindId :: Kind.Ops ActorKind -> Kind.Id ActorKind
projectileKindId Kind.Ops{ouniqGroup} = ouniqGroup "projectile"
data Target =
TEnemy ActorId Point
| TLoc Point
| TPath [Vector]
| TCursor
deriving (Show, Eq)
invalidTarget :: Target
invalidTarget =
let invalidActorId = 1
in TEnemy invalidActorId origin
instance Binary Target where
put (TEnemy a ll) = putWord8 0 >> put a >> put ll
put (TLoc loc) = putWord8 1 >> put loc
put (TPath ls) = putWord8 2 >> put ls
put TCursor = putWord8 3
get = do
tag <- getWord8
case tag of
0 -> liftM2 TEnemy get get
1 -> liftM TLoc get
2 -> liftM TPath get
3 -> return TCursor
_ -> fail "no parse (Target)"