module Game.Antisplice.Stats where
import Control.Monad
import Control.Monad.Identity
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.Atoms
import Text.Chatty.Printer
class HasStats s where
setStat :: StatKey -> Int -> s -> s
getStat :: StatKey -> s -> Int
class HasStatsM m where
setStatM :: StatKey -> Int -> m ()
getStatM :: StatKey -> m Int
instance HasStats ObjectState where
setStat k v o = o{objectStatsOf=avlInsert (k,v) $ objectStatsOf o}
getStat k o = case avlLookup k $ objectStatsOf o of
Nothing -> 0
Just v -> v
instance Monad m => HasStatsM (ObjectT m) where
setStatM k v = modifyObjectState $ setStat k v
getStatM k = (return . getStat k) =<< getObjectState
instance HasStats PlayerState where
setStat k v p = p{playerBaseStatsOf=avlInsert (k,v) $ playerBaseStatsOf p}
getStat k p = case avlLookup k $ playerBaseStatsOf p of
Nothing -> 0
Just v -> v
instance Monad m => HasStatsM (PlayerT m) where
setStatM k v = modifyPlayerState $ setStat k v
getStatM k = (return . getStat k) =<< getPlayerState
sumStat :: MonadPlayer m => StatKey -> m Int
sumStat k = do
s <- getPlayerState
let is = map (getStat k) $ avlInorder $ playerInventoryOf s
let es = map (getStat k.snd) $ avlInorder $ playerEquipOf s
return (sum is + sum es + getStat k s)
calcStat :: (Functor m,MonadPlayer m,MonadAtoms m,MonadRoom m,MonadPrinter m) => StatKey -> m Int
calcStat k = do
p <- getPlayerState
r <- getRoomState
let ss k = fst $ runIdentity $ runPlayerT (sumStat k) p
steseg (StereoSeg a) = [a]
steseg _ = []
rsegs = map steseg $ concatMap objectNearImplicationsOf $ avlInorder $ roomObjectsOf r
isegs = map steseg $ concatMap objectCarryImplicationsOf $ avlInorder $ playerInventoryOf p
stes <- fmap (map stereoCalcStatBonus) $ mapM getAtom (concat rsegs ++ concat isegs ++ playerStereosOf p)
return $ foldr (\f g k -> f g k + g k) ss stes k
defaultStereo = PlayerStereo $
\get k -> case k of
AttackPower -> get Strength * 2
_ -> 0
registerStereo :: MonadAtoms m => PlayerStereo -> m (Atom PlayerStereo)
registerStereo s = do
a <- newAtom
putAtom a s
return a
addStereo :: MonadPlayer m => Atom PlayerStereo -> m ()
addStereo a = modifyPlayerState $ \p -> p{playerStereosOf=a:playerStereosOf p}
replaceStereo :: MonadPlayer m => Atom PlayerStereo -> Atom PlayerStereo -> m ()
replaceStereo rem ins = modifyPlayerState $ \p -> p{playerStereosOf=map (\a -> if a == rem then ins else a) $ playerStereosOf p}