module Game.Antisplice.Stats where
import Control.Monad
import Control.Monad.Identity
import Data.Monoid
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.Atoms
import Game.Antisplice.Utils.None
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 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
calcStat :: (MonadPlayer m,MonadAtoms m,MonadRoom m) => StatKey -> m Int
calcStat k = do
p <- getPlayerState
let ss k = getStat k p
stes <- totalStereo
return $ stereoCalcStatBonus stes ss k + ss k
totalStereo :: (MonadAtoms m,MonadPlayer m,MonadRoom m) => m PlayerStereo
totalStereo = do
p <- getPlayerState
r <- getRoomState
let steseg r1 (Stereo r a)
| r1 == r = [a]
| otherwise = []
steseg _ _ = []
rsegs = concatMap (steseg Near) $ concatMap (avlInorder.objectFeaturesOf) $ avlInorder $ roomObjectsOf r
isegs = concatMap (steseg Carried) $ concatMap (avlInorder.objectFeaturesOf) $ avlInorder $ playerInventoryOf p
wsegs = concatMap (steseg Worn) $ concatMap (avlInorder.objectFeaturesOf) $ map snd $ avlInorder $ playerEquipOf p
stes <- mapM getAtom (rsegs ++ isegs ++ wsegs ++ playerStereosOf p)
return $ mconcat stes
instance Monoid PlayerStereo where
mempty = PlayerStereo (\_ _ -> 0) (\_ -> Nothing)
a `mappend` b = PlayerStereo
(\get k -> stereoCalcStatBonus a (\k -> stereoCalcStatBonus b get k + get k) k + stereoCalcStatBonus b get k)
(\s -> case stereoSkillBonus a s of
Nothing -> stereoSkillBonus b s
Just b -> Just b)
instance None PlayerStereo where
none = mempty