Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Updated everything to use lenses for first-class record types.

  • Loading branch information...
commit 2ede4f55f4bb04909188ce555e6e1fdf748966cf 1 parent db5b295
@periodic authored
View
16 AI/Info.hs
@@ -4,13 +4,13 @@ import Types.World
import Actions.Common
onGCD :: Action Bool
-onGCD =
- do s <- getSource
- t <- getTime
- return $ entityOnGCD s t
+onGCD = do
+ s <- getSource
+ t <- getTime
+ return $ entityOnGCD t s
abilOnCooldown :: String -> Action Bool
-abilOnCooldown name =
- do s <- getSource
- t <- getTime
- return $ entityOnCooldown s name t
+abilOnCooldown name = do
+ s <- getSource
+ t <- getTime
+ return $ entityOnCooldown name t s
View
8 AI/Warrior.hs
@@ -22,8 +22,8 @@ rotation = do
where
msName = "MortalStrike"
mortalStrike =
- Ability { abilName = msName
- , abilCooldown = Just 6
- , abilTriggerGCD = True
- , abilAction = attack msName 100
+ Ability { _abilName = msName
+ , _abilCooldown = Just 6
+ , _abilTriggerGCD = True
+ , _abilAction = attack msName 100
}
View
14 Actions/Attacks.hs
@@ -1,18 +1,16 @@
module Actions.Attacks where
+import Types.Common
import Types.World
import Actions.Common
attack :: AbilityId -> Damage -> Action ()
attack abilName dmg = do
- w <- getW
- t <- getTime
- p <- getSource
- t <- getTarget
- let t' = t { eHealth = eHealth t + dmg }
- after 0 (EvSwingDamage (eID p) (eID t) abilName dmg)
- insertEntity t'
+ src <- getSource
+ trg <- getTarget
+ modifyTarget $ modL eHealth (+ dmg)
+ after 0 (EvSwingDamage (getL eID src) (getL eID trg) abilName dmg)
-- |Make an attack with the equipped weapon, with a multiplicative modifier and flat bonus.
--weapon :: AbilityId -> Float -> Damage -> Action ()
@@ -22,7 +20,7 @@ attack abilName dmg = do
startAutoAttack :: DTime -> Damage -> Action ()
startAutoAttack timer dmg = do
src <- getSource
- let owner = eID src
+ let owner = getL eID src
addHandler name (autoAttackHandler owner)
after 0 (EvAutoAttackReady owner)
where
View
73 Actions/Common.hs
@@ -2,42 +2,46 @@ module Actions.Common where
import Prelude hiding (lookup)
import qualified DisEvSim as Sim
+import Types.Common
import Types.World
import Control.Monad.Reader
import Data.Functor ((<$>))
import Data.Map (lookup)
+import Data.Record.Label
-- * Functions on Sim
-- | This function lets us transform handlers defined on Action and lift them to Sim.
makeHandler :: Entity -> (Event -> Action ()) -> Event -> Sim World Event ()
makeHandler e a ev = do
- mpEntity <- getEntity . eID $ e
+ mpEntity <- getEntity . (getL eID) $ e
case mpEntity of
Nothing -> return ()
Just pEntity -> do
- mtEntity <- getEntity . eTarget $ pEntity
+ mtEntity <- getEntity . (getL eTarget) $ pEntity
case mtEntity of
Nothing -> return ()
Just tEntity -> (flip runReaderT) (ActionState pEntity tEntity) $ a ev
-- | Get an entity based on the ID.
getEntity :: EntityId -> Sim World Event (Maybe Entity)
-getEntity eid = (lookup eid . wEntities) `fmap` Sim.getW
+getEntity eid = (lookup eid . getL wEntities) `fmap` Sim.getW
-- * Functions on Action
--- ** Data manipulation functions
+-- ** Lifters from Sim to Action
+getW :: Action World
getW = lift Sim.getW
+putW :: World -> Action ()
putW = lift . Sim.putW
modW :: (World -> World) -> Action ()
modW = lift . Sim.modW
+getTime :: Action Time
getTime = lift Sim.getT
+after :: DTime -> Event -> Action ()
after t ev = lift $ Sim.after t ev
-getSource = actionSource <$> ask
-getTarget = actionTarget <$> ask
--- ** Other functions
+-- ** Affect Handlers
addHandler :: String -> (Event -> Action ()) -> Action()
addHandler name handler = do
actionState <- ask
@@ -49,40 +53,49 @@ transformHandler h = do
actionState <- ask
return $ (flip runReaderT $ actionState) . h
+-- ** Manipulate Entities
+
insertEntity :: Entity -> Action ()
-insertEntity e = do
- w <- getW
- putW $ w { wEntities = updateEntityList e (wEntities w)}
+insertEntity e = modW $ modL wEntities (updateEntityList e)
+
+modifyEntity :: EntityId -> (Entity -> Entity) -> Action ()
+modifyEntity eid f = modW $ modL wEntities (adjustEntityInList f eid)
+
+getSource :: Action Entity
+getSource = getL actionSource <$> ask
+getTarget :: Action Entity
+getTarget = getL actionTarget <$> ask
+
+modifySource :: (Entity -> Entity) -> Action ()
+modifySource f = do
+ sid <- getL eID <$> getSource
+ modW $ modL wEntities (adjustEntityInList f sid)
+modifyTarget :: (Entity -> Entity) -> Action ()
+modifyTarget f = do
+ tid <- getL eID <$> getTarget
+ modW $ modL wEntities (adjustEntityInList f tid)
+-- ** Manipulate the source entity
resetGCD :: Action ()
resetGCD =
- do w <- getW
- t <- getTime
+ do t <- getTime
+ modifySource (setL eGlobalCD (t + 1.5))
src <- getSource
- targ <- getTarget
- let src' = src { eGlobalCD = t + 1.5 }
- insertEntity src'
- after 1.5 . EvGcdEnd . eID $ src
+ after 1.5 . EvGcdEnd . getL eID $ src
setCooldown :: String -> Sim.DTime -> Action ()
setCooldown name dt =
- do w <- getW
- t <- getTime
- p <- getSource
- let p' = entityAddCooldown p name (t + dt)
- insertEntity p'
+ do t <- getTime
+ src <- getSource
+ modifySource (entityAddCooldown name (t + dt))
+ after dt (EvCooldownExpire (getL eID src) name)
useAbility :: Ability -> Action ()
useAbility abil = do
- w <- getW
- t <- getTime
- p <- getSource
- if (abilTriggerGCD abil)
+ if (getL abilTriggerGCD abil)
then resetGCD
else return ()
- case (abilCooldown abil) of
+ case (getL abilCooldown abil) of
Nothing -> return ()
- Just dt -> do
- setCooldown (abilName abil) dt
- after dt (EvCooldownExpire (eID p) (abilName abil))
- abilAction abil
+ Just dt -> setCooldown (getL abilName abil) dt
+ getL abilAction abil
View
30 Types/Common.hs
@@ -30,8 +30,8 @@ data SimConfig = SimConfig {
- General types
----------------------------------------}
-data ActionState = ActionState { actionSource :: Entity
- , actionTarget :: Entity
+data ActionState = ActionState { _actionSource :: Entity
+ , _actionTarget :: Entity
} deriving (Show)
type Action = ReaderT ActionState (Sim World Event)
@@ -46,16 +46,16 @@ instance Show EntityId where
type EntityMap = Map EntityId Entity
-data Entity = Entity { eID :: !EntityId
- , eTarget :: !EntityId
- , eHealth :: !Health
- , eGlobalCD :: !Time
- , eCooldowns :: Map String Time
- , eStats :: Stats
+data Entity = Entity { _eID :: !EntityId
+ , _eTarget :: !EntityId
+ , _eHealth :: !Health
+ , _eGlobalCD :: !Time
+ , _eCooldowns :: Map String Time
+ , _eStats :: Stats
} deriving (Show)
-data World = World { wEntities :: EntityMap
- , wGen :: !StdGen
+data World = World { _wEntities :: EntityMap
+ , _wGen :: !StdGen
} deriving (Show)
data Event = EvSimStart
@@ -70,10 +70,10 @@ data Event = EvSimStart
type AbilityMap = Map AbilityId Ability
type AbilityId = String
-data Ability = Ability { abilName :: String
- , abilCooldown :: Maybe DTime
- , abilTriggerGCD :: Bool
- , abilAction :: Action ()
+data Ability = Ability { _abilName :: String
+ , _abilCooldown :: Maybe DTime
+ , _abilTriggerGCD :: Bool
+ , _abilAction :: Action ()
}
{----------------------------------------
@@ -206,4 +206,4 @@ data Stats = Stats { _level :: Integer
, _spellCritMult :: Float
} deriving (Show)
-$(mkLabels [''Stats])
+$(mkLabels [''Ability, ''Action, ''ActionState, ''Entity, ''World, ''Stats])
View
43 Types/Entity.hs
@@ -6,51 +6,56 @@ module Types.Entity ( Entity(..)
, makeEntity
, addEntityList
, updateEntityList
+ , lookupEntityInList
+ , adjustEntityInList
) where
import Prelude hiding (lookup)
import DisEvSim (DTime, Time)
import Data.Map
+import Data.Record.Label
import Types.Common
import Types.EntityId
import Types.Stats
-- |Create a default entity.
-makeEntity name targ = Entity { eID = getIdFromString name
- , eTarget = getIdFromString targ
- , eHealth = 0
- , eGlobalCD = 0
- , eCooldowns = empty
- , eStats = defaultStats
+makeEntity name targ = Entity { _eID = getIdFromString name
+ , _eTarget = getIdFromString targ
+ , _eHealth = 0
+ , _eGlobalCD = 0
+ , _eCooldowns = empty
+ , _eStats = defaultStats
}
-- |Add an entity to the entity map.
addEntityList :: Entity -> EntityMap -> EntityMap
-addEntityList e map = insert (eID e) e map
+addEntityList e map = insert (getL eID e) e map
-- |Update an entity, replacing the old entity with the new one.
updateEntityList :: Entity -> EntityMap -> EntityMap
-updateEntityList e map = insert (eID e) e map
+updateEntityList e map = insert (getL eID e) e map
-- |Update an entity, replacing the old entity with the new one.
-lookupEntityFromList :: Entity -> EntityMap -> Maybe Entity
-lookupEntityFromList e map = lookup (eID e) map
+lookupEntityInList :: Entity -> EntityMap -> Maybe Entity
+lookupEntityInList e map = lookup (getL eID e) map
+
+-- |Adjust an entity in the list
+adjustEntityInList :: (Entity -> Entity) -> EntityId -> EntityMap -> EntityMap
+adjustEntityInList f eid = adjust f eid
-- |Test whether an entity is in GCD
-entityOnGCD :: Entity -> Time -> Bool
-entityOnGCD e t = eGlobalCD e > t
+entityOnGCD :: Time -> Entity -> Bool
+entityOnGCD t e = getL eGlobalCD e > t
-- |Test whether the entity has the named ability on cooldown
-entityOnCooldown :: Entity -> String -> Time -> Bool
-entityOnCooldown e name t =
- case Data.Map.lookup name (eCooldowns e) of
+entityOnCooldown :: String -> Time -> Entity -> Bool
+entityOnCooldown name t e =
+ case Data.Map.lookup name (getL eCooldowns e) of
Nothing -> False
Just t' -> t' > t
-- |Add a cooldown to the entity's cooldown map.
-entityAddCooldown :: Entity -> String -> Time -> Entity
-entityAddCooldown e name t =
- let cds = insert name t (eCooldowns e)
- in e { eCooldowns = cds }
+entityAddCooldown :: String -> Time -> Entity -> Entity
+entityAddCooldown name t e = modL eCooldowns (insert name t) e
View
19 Types/World.hs
@@ -3,10 +3,14 @@ module Types.World (
getId
, addEntityList
, updateEntityList
+ , lookupEntityInList
+ , adjustEntityInList
, entityOnGCD
, entityOnCooldown
, entityAddCooldown
, makeEntity
+ -- From Types.EntityId
+ , getIdFromString
-- From Types.Common
, Damage
, Health
@@ -23,17 +27,16 @@ module Types.World (
, DTime
, Time
, Sim
+ -- From Data.Record.Label
+ , getL
+ , setL
+ , modL
) where
-import DisEvSim (DTime, Time, Sim)
import Types.Common
import Types.Entity
+import Types.EntityId
import Types.Event
-import Control.Monad.State
-
-{-
-data World = World { player :: !Entity
- , target :: !Entity
- } deriving (Show)
--}
+import DisEvSim (DTime, Time, Sim)
+import Data.Record.Label (getL, modL, setL)
View
12 WoWSim.hs
@@ -1,7 +1,7 @@
module Main where
+import Types.Common
import Types.World
-import Types.EntityId
import DisEvSim
@@ -22,13 +22,17 @@ main = do
let pEntity = makeEntity "Player" "Target"
tEntity = makeEntity "Target" "Player"
entities = addEntityList pEntity . addEntityList tEntity $ empty
- world = World { wEntities = entities
- , wGen = gen
+ -- TODO: move this to Types.World
+ world = World { _wEntities = entities
+ , _wGen = gen
}
ai = makeHandler pEntity warrior
config = defaultConfig { enableLog = True }
(t, log, world') = {-# SCC "sim" #-} simulate config world [("Warrior", ai)] EvSimStart (read dur)
putStrLn . showLog $ log
- print $ (t, Map.lookup (getIdFromString "Target") . wEntities $ world')
+ let tFinal = Map.lookup (getIdFromString "Target") . getL wEntities $ world'
+ case tFinal of
+ Just targ -> print $ (t, getL eHealth targ)
+ Nothing -> print $ (t)
showLog = intercalate "\n" . map (\(t,e) -> show t ++ " - " ++ show e)
Please sign in to comment.
Something went wrong with that request. Please try again.