module Game.LambdaHack.Actor
(
ActorId, findHeroName, monsterGenChance
, PartyId, heroParty, enemyParty, animalParty
, heroProjectiles, enemyProjectiles, animalProjectiles, allProjectiles
, Actor(..), template, addHp, 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 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
newtype PartyId = PartyId Int
deriving (Show, Eq, Ord)
heroParty, enemyParty, animalParty,
heroProjectiles, enemyProjectiles, animalProjectiles :: PartyId
heroParty = PartyId 0
enemyParty = PartyId 1
animalParty = PartyId 2
heroProjectiles = PartyId 3
enemyProjectiles = PartyId 4
animalProjectiles = PartyId 5
allProjectiles :: [PartyId]
allProjectiles = [heroProjectiles, enemyProjectiles, animalProjectiles]
instance Binary PartyId where
put (PartyId n) = put n
get = fmap PartyId get
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
, bparty :: !PartyId
}
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 bparty
get = do
bkind <- get
bsymbol <- get
bname <- get
bcolor <- get
bspeed <- get
bhp <- get
bdir <- get
btarget <- get
bloc <- get
bletter <- get
btime <- get
bparty <- 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 (25 + 20 * (numMonsters depth)) `max` 5)
template :: Kind.Id ActorKind -> Maybe Char -> Maybe String -> Int -> Point
-> Time -> PartyId -> Actor
template bkind bsymbol bname bhp bloc btime bparty =
let bcolor = Nothing
bspeed = Nothing
btarget = invalidTarget
bdir = Nothing
bletter = 'a'
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)}
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"
actorSpeed :: Kind.Ops ActorKind -> Actor -> Speed
actorSpeed Kind.Ops{okind} m =
let stockSpeed = aspeed $ okind $ bkind m
in fromMaybe stockSpeed $ bspeed m
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)"