Rework the protoeffect system
& Add ActingUnit/TargettedUnit newtypes
This commit is contained in:
parent
7a501ac927
commit
4e408135d8
GPG key ID:
A12F2C2FFDC3D847
|
|
@ -28,9 +28,10 @@ import Safe (atMay)
|
|||
|
||||
import Mechanics (universalModifiers, globalHooks)
|
||||
import Data.Monoid (Any(getAny), getSum)
|
||||
import Data.Coerce
|
||||
|
||||
-- | A version of `computeStat_` using `universalModifiers` as global modifiers
|
||||
computeStat :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
computeStat :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Stat a -> a
|
||||
computeStat = computeStat_ universalModifiers
|
||||
|
||||
-- | A version of `runHooks_` using `globalHooks` as the global hooks
|
||||
|
|
@ -49,7 +50,7 @@ data EngineState
|
|||
playerChoice :: Player -> [Choice] -> EngineState
|
||||
playerChoice = PlayerChoice
|
||||
|
||||
unitChoice :: CharacterIdentifier -> [Choice] -> EngineState
|
||||
unitChoice :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> [Choice] -> EngineState
|
||||
unitChoice = playerChoice . owner
|
||||
|
||||
activePlayerChoice :: BoardState -> [Choice] -> EngineState
|
||||
|
|
@ -64,8 +65,8 @@ chooseCharacter board = playerChoice player <$> fmap toList (nonEmpty $ board ^.
|
|||
player :: Player
|
||||
player = board ^. activePlayer
|
||||
possibleActivations :: SimpleFold BoardState Choice
|
||||
possibleActivations = untappedUnits . filtered ((== player) . owner) . to activateUnit
|
||||
activateUnit :: CharacterIdentifier -> Choice
|
||||
possibleActivations = untappedUnits . filtered ((== player) . owner) . to (activateUnit . ActingUnit)
|
||||
activateUnit :: ActingUnit -> Choice
|
||||
activateUnit cid = mkChoice ("Activate unit " ++ c) [ChooseActMove cid]
|
||||
where
|
||||
c = renderCharacterHandle board cid
|
||||
|
|
@ -109,8 +110,8 @@ computePossibleSteps board (MovementSpecs {..}) currentLocation = mapMaybe getRe
|
|||
endOfMovementEffects :: MovementSpecs -> CharacterIdentifier -> [Effect]
|
||||
endOfMovementEffects (MovementSpecs {..}) cid =
|
||||
[ConfirmMove]
|
||||
++ [DropToken SpeedSlow cid | movSpendTokens ]
|
||||
++ [Event $ Broadcast EndMove cid | movEndMoveTrigger]
|
||||
++ [DropToken SpeedSlow (TargettedUnit cid) | movSpendTokens ]
|
||||
++ [Event $ Broadcast EndMove (ActingUnit cid) | movEndMoveTrigger]
|
||||
|
||||
generateMovementChoice :: BoardState -> MovementSpecs -> CharacterIdentifier -> Point -> (Point, Natural) -> Choice
|
||||
generateMovementChoice board specs@(MovementSpecs {..}) cid originalLocation (dest, remainingMov) =
|
||||
|
|
@ -201,7 +202,7 @@ applyEffect (Move specs@(MovementSpecs{..}) cid) board = case unitPosition board
|
|||
dontMoveChoice = mkChoice "Don't move" dontMoveEffects
|
||||
finishMoveEffects = endOfMovementEffects specs cid
|
||||
finishMoveChoice = mkChoice "Finish moving" finishMoveEffects
|
||||
endMoveTrigger = Event $ Broadcast EndMove cid
|
||||
endMoveTrigger = Event $ Broadcast EndMove (ActingUnit cid)
|
||||
choiceBuilder = maybe (unitChoice cid) playerChoice $ movForced ^? _Just . _3
|
||||
applyEffect (MoveTo dest) board = continue $ moveUnit dest board
|
||||
applyEffect (DropToken token unit) board = continue $
|
||||
|
|
@ -213,22 +214,22 @@ applyEffect (Act cid) board = case board ^.. ixCharacter cid . baseStats . actio
|
|||
applyEffect (Target fromPerspective range eligability ultimateEffect) board = unitChoice fromPerspective choices
|
||||
where
|
||||
locus = unitPosition board fromPerspective
|
||||
potentialUnits = maybe [] (cidsInRange board range) locus
|
||||
potentialUnits = TargettedUnit <$> (maybe [] (cidsInRange board range) locus)
|
||||
eligableUnits = filter (eligability board) potentialUnits
|
||||
buildChoice targetCid =
|
||||
mkChoice
|
||||
("Target " ++ renderCharacterHandle board targetCid)
|
||||
[BodyBlock targetCid ultimateEffect]
|
||||
choices = buildChoice <$> eligableUnits
|
||||
applyEffect (BodyBlock targettedUnit ultimateEffect) board = if canBB then allChoices else cantBBResult
|
||||
applyEffect (BodyBlock originalTarget ultimateEffect) board = if canBB then allChoices else cantBBResult
|
||||
where
|
||||
potentialBBers = fromMaybe [] $ adjacentAllies board targettedUnit
|
||||
canBB = isNecromancer targettedUnit && not (null potentialBBers)
|
||||
potentialBBers = fromMaybe [] $ adjacentAllies board originalTarget
|
||||
canBB = isNecromancer originalTarget && not (null potentialBBers)
|
||||
buildChoice bber = mkChoice ("Bodyblock with " ++ renderCharacterHandle board bber) (ultimateEffect bber)
|
||||
dontBodyblock = mkChoice "Take the hit to your necromancer" (ultimateEffect targettedUnit)
|
||||
bbChoices = buildChoice <$> potentialBBers
|
||||
allChoices = unitChoice targettedUnit $ dontBodyblock : bbChoices
|
||||
cantBBResult = continue $ board <++ ultimateEffect targettedUnit
|
||||
dontBodyblock = mkChoice "Take the hit to your necromancer" (ultimateEffect originalTarget)
|
||||
bbChoices = buildChoice . TargettedUnit <$> potentialBBers
|
||||
allChoices = unitChoice originalTarget $ dontBodyblock : bbChoices
|
||||
cantBBResult = continue $ board <++ ultimateEffect originalTarget
|
||||
applyEffect (ResolveAttack attacker attack defender) board = Roll actualDiceRolled keepHighest consequence
|
||||
where
|
||||
attacker' = board ^? ixCharacter attacker
|
||||
|
|
|
|||
122
src/GameModel.hs
122
src/GameModel.hs
|
|
@ -6,6 +6,10 @@ module GameModel
|
|||
, Armor(..)
|
||||
, DamageType(..)
|
||||
, Attack(Attack)
|
||||
, ActingUnit(..)
|
||||
, actingUnit
|
||||
, TargettedUnit(..)
|
||||
, targettedUnit
|
||||
, headshotEffectsL
|
||||
, meleeL
|
||||
, otherEffectsL
|
||||
|
|
@ -69,6 +73,7 @@ module GameModel
|
|||
, getDefense
|
||||
, statusEffects
|
||||
, CharacterIdentifier
|
||||
, cidEq
|
||||
, owner
|
||||
, ownerL
|
||||
, isNecromancer
|
||||
|
|
@ -158,6 +163,7 @@ import Lens.Micro.TH (makeLenses, makeLensesWith, generateUpdateableOptics)
|
|||
import Lens.Micro.Extras (preview)
|
||||
import Data.Data ((:~:)(..))
|
||||
import System.Random (Random(..))
|
||||
import Data.Coerce
|
||||
|
||||
data DieFace = One | Two | Three | Four | Five | Six
|
||||
deriving (Eq, Ord, Enum, Read)
|
||||
|
|
@ -224,14 +230,23 @@ instance Num DieFace where
|
|||
|
||||
type CharacterIdentifier = (Player, Int)
|
||||
|
||||
owner :: CharacterIdentifier -> Player
|
||||
owner = fst
|
||||
cidEq :: (Coercible a b, Eq b) => a -> b -> Bool
|
||||
cidEq = (==) . coerce
|
||||
|
||||
owner :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Player
|
||||
owner cid' = fst cid
|
||||
where
|
||||
cid :: CharacterIdentifier
|
||||
cid = coerce cid'
|
||||
|
||||
ownerL :: Lens' CharacterIdentifier Player
|
||||
ownerL = _1
|
||||
|
||||
isNecromancer :: CharacterIdentifier -> Bool
|
||||
isNecromancer = snd >>> (== 0)
|
||||
isNecromancer :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Bool
|
||||
isNecromancer cid' = (==0) $ snd cid
|
||||
where
|
||||
cid :: CharacterIdentifier
|
||||
cid = coerce cid'
|
||||
|
||||
showCID :: CharacterIdentifier -> Char
|
||||
showCID (cidOwner, idx) = (if cidOwner == Max then upperLetters else lowerLetters) !! idx
|
||||
|
|
@ -300,9 +315,9 @@ enumeratePoints w h = Point <$> [0..w * h - 1]
|
|||
|
||||
data Trigger a where
|
||||
TurnStart :: Trigger ()
|
||||
TookDamage :: Trigger CharacterIdentifier
|
||||
Died :: Trigger (CharacterIdentifier, Point)
|
||||
EndMove :: Trigger CharacterIdentifier
|
||||
TookDamage :: Trigger TargettedUnit
|
||||
Died :: Trigger (TargettedUnit, Point)
|
||||
EndMove :: Trigger ActingUnit
|
||||
|
||||
deriving instance Eq (Trigger a)
|
||||
deriving instance Show (Trigger a)
|
||||
|
|
@ -423,8 +438,8 @@ data ProtoMovementSpecs = ProtoMovementSpecs
|
|||
, movCompelled :: Bool -- ^ If movement can be stopped prematurely
|
||||
}
|
||||
|
||||
basicMove :: CharacterIdentifier -> Effect
|
||||
basicMove = InitMove $ ProtoMovementSpecs
|
||||
basicMove :: ActingUnit -> Effect
|
||||
basicMove = (InitMove $ ProtoMovementSpecs
|
||||
{ movVerb = "Move"
|
||||
, movFree' = Nothing
|
||||
, movMinimum = True
|
||||
|
|
@ -433,10 +448,10 @@ basicMove = InitMove $ ProtoMovementSpecs
|
|||
, movSpendTokens = True
|
||||
, movEndMoveTrigger = True
|
||||
, movCompelled = False
|
||||
}
|
||||
}) . (^. actingUnit)
|
||||
|
||||
forcedMove :: ForcedMoveType -> Natural -> Player -> Either CharacterIdentifier Point -> CharacterIdentifier -> Effect
|
||||
forcedMove fmType amt compeller locus = InitMove $ ProtoMovementSpecs
|
||||
forcedMove :: ForcedMoveType -> Natural -> Player -> Either CharacterIdentifier Point -> TargettedUnit -> Effect
|
||||
forcedMove fmType amt compeller locus = (InitMove $ ProtoMovementSpecs
|
||||
{ movVerb = show fmType
|
||||
, movFree' = Just True
|
||||
, movMinimum = False
|
||||
|
|
@ -445,7 +460,25 @@ forcedMove fmType amt compeller locus = InitMove $ ProtoMovementSpecs
|
|||
, movSpendTokens = False
|
||||
, movEndMoveTrigger = False
|
||||
, movCompelled = True
|
||||
}
|
||||
}) . (^. targettedUnit)
|
||||
|
||||
-- | Designates a character identifier of the unit acting in an effect/event
|
||||
--
|
||||
-- Acting includes moving, attacking, or using an ability
|
||||
newtype ActingUnit = ActingUnit CharacterIdentifier
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A lens reaching into `ActingUnit`
|
||||
actingUnit :: Lens' ActingUnit CharacterIdentifier
|
||||
actingUnit f (ActingUnit au) = ActingUnit <$> f au
|
||||
|
||||
-- | Designates a character identifier of the unit being targetted by an effect/attack
|
||||
newtype TargettedUnit = TargettedUnit CharacterIdentifier
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A lens reaching into `TargettedUnit`
|
||||
targettedUnit :: Lens' TargettedUnit CharacterIdentifier
|
||||
targettedUnit f (TargettedUnit au) = TargettedUnit <$> f au
|
||||
|
||||
data Effect
|
||||
|
||||
|
|
@ -458,10 +491,10 @@ data Effect
|
|||
| Event Broadcast
|
||||
|
||||
-- | Active player chooses whether they want to move or act first
|
||||
| ChooseActMove CharacterIdentifier
|
||||
| ChooseActMove ActingUnit
|
||||
|
||||
-- | Active player may choose whether they want to act or move
|
||||
| ActOrMove CharacterIdentifier
|
||||
| ActOrMove ActingUnit
|
||||
|
||||
-- | Mark the start of movement
|
||||
-- Can be finalized later with FinalizeMove
|
||||
|
|
@ -483,51 +516,51 @@ data Effect
|
|||
-- | Remove up to one token from the given category from a unit
|
||||
| forall n. Num n => DropToken
|
||||
(Token n) -- ^ The token category to drop from
|
||||
CharacterIdentifier -- ^ Which character drops a token
|
||||
TargettedUnit -- ^ Which character drops a token
|
||||
|
||||
-- | Confirms a Move, placing the unit in the target space
|
||||
| ConfirmMove
|
||||
|
||||
-- | Allow a character to Act
|
||||
| Act CharacterIdentifier
|
||||
| Act ActingUnit
|
||||
|
||||
-- | Target a unit in a given range, then run a different event
|
||||
| Target
|
||||
CharacterIdentifier -- ^ ACTing unit
|
||||
ActingUnit -- ^ ACTing unit
|
||||
(Natural, Natural) -- ^ Range
|
||||
(BoardState -> CharacterIdentifier -> Bool) -- ^ Target filter
|
||||
(CharacterIdentifier -> [Effect]) -- ^ Ultimate effect
|
||||
(BoardState -> TargettedUnit -> Bool) -- ^ Target filter
|
||||
(TargettedUnit -> [Effect]) -- ^ Ultimate effect
|
||||
|
||||
-- | Check if a character can body block
|
||||
-- If they can, offer a choice of target to the targetted player. Pass result on to
|
||||
-- the effect.
|
||||
| BodyBlock CharacterIdentifier (CharacterIdentifier -> [Effect])
|
||||
| BodyBlock TargettedUnit (TargettedUnit -> [Effect])
|
||||
|
||||
-- | Resolve an attack
|
||||
| ResolveAttack
|
||||
CharacterIdentifier -- ^ Attacker
|
||||
ActingUnit -- ^ Attacker
|
||||
Attack -- ^ Attack information
|
||||
CharacterIdentifier -- ^ Target
|
||||
TargettedUnit -- ^ Target
|
||||
|
||||
| InflictDamage
|
||||
DamageType
|
||||
Natural -- ^ Damage amount
|
||||
CharacterIdentifier -- ^ Target
|
||||
TargettedUnit -- ^ Target
|
||||
|
||||
-- | Add a status effect to a character
|
||||
| InflictStatusEffect
|
||||
StatusEffect -- ^ Effect to inflict
|
||||
CharacterIdentifier -- ^ Target
|
||||
TargettedUnit -- ^ Target
|
||||
|
||||
| forall n. Num n => InflictTokens
|
||||
(Token n) -- ^ Token kind
|
||||
n -- ^ Token amount
|
||||
CharacterIdentifier -- ^ Target
|
||||
TargettedUnit -- ^ Target
|
||||
|
||||
| Kill CharacterIdentifier
|
||||
| Kill TargettedUnit
|
||||
|
||||
-- | Tap the active unit, change the active player
|
||||
| EndTurn CharacterIdentifier
|
||||
| EndTurn ActingUnit
|
||||
|
||||
data Attack = Attack
|
||||
{ headshotEffects :: [Effect]
|
||||
|
|
@ -577,7 +610,7 @@ data BaseStats = BaseStats
|
|||
, df :: DieFace
|
||||
, arm :: Armor
|
||||
, traits :: [Trait]
|
||||
, actions :: [CharacterIdentifier -> Choice]
|
||||
, actions :: [ActingUnit -> Choice]
|
||||
}
|
||||
|
||||
-- | Some effect which is activated by some trigger event
|
||||
|
|
@ -838,10 +871,11 @@ untap = movedThisRound .~ False
|
|||
--
|
||||
-- This includes so called global modifiers, but in order to keep game rules seperate from
|
||||
-- the model, global modifiers must be provided as the first argument.
|
||||
computeStat_ :: [Modifier] -> BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
computeStat_ globalModifiers board cid stat = case allStatsAreMonoids stat of
|
||||
computeStat_ :: (Coercible cid c, c ~ CharacterIdentifier) => [Modifier] -> BoardState -> cid -> Stat a -> a
|
||||
computeStat_ globalModifiers board cid' stat = case allStatsAreMonoids stat of
|
||||
HasMonoidInstance Refl ->
|
||||
let
|
||||
cid = coerce cid'
|
||||
queryStatsL = each . to (queryModifier board cid stat)
|
||||
globalBonus = globalModifiers ^. queryStatsL
|
||||
traitBonus = board ^. ixCharacter cid . baseStats . traitsL . each . traitModifiersL . queryStatsL
|
||||
|
|
@ -1016,11 +1050,13 @@ offsetB b = usingBoardDimensions b offset
|
|||
eachCID :: Monoid m => Getting m BoardState CharacterIdentifier
|
||||
eachCID = tiles . each . _1 . _Just
|
||||
|
||||
ixCharacter :: CharacterIdentifier -> Traversal' BoardState Character
|
||||
ixCharacter (player, indx) = characters . forPlayer player . ix indx
|
||||
ixCharacter :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Traversal' BoardState Character
|
||||
ixCharacter cid = case coerce cid of (player, indx) -> characters . forPlayer player . ix indx
|
||||
|
||||
renderCharacterHandle :: BoardState -> CharacterIdentifier -> String
|
||||
renderCharacterHandle board cid = maybe "[💀]" (characterHandle cid) $ board ^? ixCharacter cid
|
||||
renderCharacterHandle :: (Coercible a b, b ~ CharacterIdentifier) => BoardState -> a -> String
|
||||
renderCharacterHandle board cid' = maybe "[💀]" (characterHandle cid) $ board ^? ixCharacter cid
|
||||
where
|
||||
cid = coerce cid'
|
||||
|
||||
eachCharacter :: Traversal' BoardState Character
|
||||
eachCharacter = characters . everybody . traverse
|
||||
|
|
@ -1070,14 +1106,14 @@ isAlive board cid = has (eachCID . filtered (== cid)) board
|
|||
pushEffects :: [Effect] -> BoardState -> BoardState
|
||||
pushEffects newEffects = effectStack %~ (newEffects ++)
|
||||
|
||||
unitPosition :: BoardState -> CharacterIdentifier -> Maybe Point
|
||||
unitPosition :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe Point
|
||||
unitPosition (BoardState {_movingUnit=Just (movingCid, movingPoint)}) cid
|
||||
| movingCid == cid = Just movingPoint
|
||||
| movingCid == coerce cid = Just movingPoint
|
||||
unitPosition (BoardState {_tiles}) cid = headMay . catMaybes $ zipWith aux [0..] _tiles
|
||||
where
|
||||
aux :: Natural -> (Maybe CharacterIdentifier, [EnvTile]) -> Maybe Point
|
||||
aux p (potentialCid, _)
|
||||
| potentialCid == Just cid = Just $ Point p
|
||||
| potentialCid == Just (coerce cid) = Just $ Point p
|
||||
| otherwise = Nothing
|
||||
|
||||
atPoint :: Point -> Traversal' BoardState (Maybe CharacterIdentifier, [EnvTile])
|
||||
|
|
@ -1092,7 +1128,7 @@ characterAt p f board = inner f board
|
|||
inner :: Traversal' BoardState (Maybe CharacterIdentifier)
|
||||
inner = atPoint p . _1 . filtered (/= board ^? movingUnit . _Just . _1)
|
||||
|
||||
adjacentUnits :: BoardState -> CharacterIdentifier -> Maybe [CharacterIdentifier]
|
||||
adjacentUnits :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe [CharacterIdentifier]
|
||||
adjacentUnits board cid = do
|
||||
originalLocation <- unitPosition board cid
|
||||
let adjacentTiles = usingBoardDimensions board adjacentPoints originalLocation
|
||||
|
|
@ -1100,14 +1136,14 @@ adjacentUnits board cid = do
|
|||
let unitsAdjacent = mapMaybe (flip preview board . characterAt') adjacentTiles
|
||||
return unitsAdjacent
|
||||
|
||||
adjacentAllies :: BoardState -> CharacterIdentifier -> Maybe [CharacterIdentifier]
|
||||
adjacentAllies :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe [CharacterIdentifier]
|
||||
adjacentAllies board cid = filter (owner >>> (owner cid ==)) <$> adjacentUnits board cid
|
||||
|
||||
isElevated :: BoardState -> CharacterIdentifier -> Bool
|
||||
isElevated :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Bool
|
||||
isElevated board cid = any (\p -> elem Elevation $ board ^. terrainAt p) $ unitPosition board cid
|
||||
|
||||
removeUnit :: CharacterIdentifier -> BoardState -> BoardState
|
||||
removeUnit cid = tiles . each . _1 %~ mfilter (/= cid)
|
||||
removeUnit :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> BoardState -> BoardState
|
||||
removeUnit cid = tiles . each . _1 %~ mfilter (/= coerce cid)
|
||||
|
||||
setUnit :: CharacterIdentifier -> Point -> BoardState -> BoardState
|
||||
setUnit character point = atPoint point . _1 ?~ character
|
||||
|
|
|
|||
|
|
@ -5,8 +5,10 @@ module Units.Carcass
|
|||
|
||||
import GameModel
|
||||
( adjacentAllies
|
||||
, ActingUnit
|
||||
, Armor(..)
|
||||
, BaseStats(..)
|
||||
, BoardState
|
||||
, CharacterIdentifier
|
||||
, Choice
|
||||
, DamageType(..)
|
||||
|
|
@ -20,6 +22,7 @@ import Units.Components
|
|||
, anyTarget
|
||||
, buildAttack, inflictTokens, push
|
||||
)
|
||||
import Data.Monoid (Sum)
|
||||
|
||||
gunwight :: BaseStats
|
||||
gunwight = BaseStats
|
||||
|
|
@ -32,7 +35,7 @@ gunwight = BaseStats
|
|||
, traits = [formation]
|
||||
}
|
||||
|
||||
gunwightActions :: [CharacterIdentifier -> Choice]
|
||||
gunwightActions :: [ActingUnit -> Choice]
|
||||
gunwightActions =
|
||||
[ buildAttack $ AttackT
|
||||
{ tName = "OL45"
|
||||
|
|
@ -63,6 +66,7 @@ formation = Trait
|
|||
, traitModifiers = [formationModifier]
|
||||
}
|
||||
where
|
||||
formationF :: BoardState -> CharacterIdentifier -> Sum Int
|
||||
formationF board cid = if adjacentAllies board cid /= Just [] then 1 else 0
|
||||
formationModifier = Modifier
|
||||
{ modifierStat = AttackDice
|
||||
|
|
|
|||
|
|
@ -19,10 +19,13 @@ import GameModel
|
|||
, Choice
|
||||
, DamageType
|
||||
, Effect(..)
|
||||
, mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect
|
||||
, ActingUnit(..), TargettedUnit(..)
|
||||
, actingUnit
|
||||
, mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect, DieFace
|
||||
)
|
||||
|
||||
import Numeric.Natural (Natural)
|
||||
import Lens.Micro
|
||||
|
||||
-------------------------
|
||||
-- Attacks & Abilities --
|
||||
|
|
@ -31,7 +34,7 @@ import Numeric.Natural (Natural)
|
|||
data AttackT = AttackT
|
||||
{ tName :: String
|
||||
, tRange :: (Natural, Natural)
|
||||
, tValidTargets :: BoardState -> CharacterIdentifier -> Bool
|
||||
, tValidTargets :: BoardState -> TargettedUnit -> Bool
|
||||
, tMelee :: Bool
|
||||
, tDamageType :: DamageType
|
||||
, tDamageAmount :: Natural
|
||||
|
|
@ -39,16 +42,16 @@ data AttackT = AttackT
|
|||
, tStandardEffects :: [ProtoEffect]
|
||||
}
|
||||
|
||||
anyTarget :: BoardState -> CharacterIdentifier -> Bool
|
||||
anyTarget :: BoardState -> TargettedUnit -> Bool
|
||||
anyTarget = const $ const True
|
||||
|
||||
buildAttack :: AttackT -> CharacterIdentifier -> Choice
|
||||
buildAttack :: AttackT -> ActingUnit -> Choice
|
||||
buildAttack (AttackT {..}) attacker = mkChoice tName [targetEffect]
|
||||
where
|
||||
attackDetails target = Attack
|
||||
((sequence $ sequence tHeadshotEffects attacker) target)
|
||||
(mkEffect attacker target tHeadshotEffects)
|
||||
tMelee
|
||||
((sequence $ sequence tStandardEffects attacker) target)
|
||||
(mkEffect attacker target tStandardEffects)
|
||||
tDamageType
|
||||
tDamageAmount
|
||||
attackEffect target = [ResolveAttack attacker (attackDetails target) target]
|
||||
|
|
@ -59,23 +62,64 @@ data SelfAbilityT = SelfAbilityT
|
|||
, tEffects :: [ProtoEffect]
|
||||
}
|
||||
|
||||
mkSelfAbility :: SelfAbilityT -> CharacterIdentifier -> Choice
|
||||
mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (sequence (sequence tEffects cid) cid)
|
||||
mkSelfAbility :: SelfAbilityT -> ActingUnit -> Choice
|
||||
mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (mkEffect cid (TargettedUnit $ cid ^. actingUnit) tEffects)
|
||||
|
||||
-----------------------------
|
||||
--------- Effects -----------
|
||||
-----------------------------
|
||||
|
||||
type ProtoEffect = CharacterIdentifier -> CharacterIdentifier -> Effect
|
||||
-- | Indicates a possible argument to a protoeffect
|
||||
--
|
||||
-- A valid argument to a protoeffect is any argument with which provide by placing the
|
||||
-- protoeffect in an `Effect`. For example, a `DieFace` is a valid question because there
|
||||
-- exists an `Effect` which accepts a type @`DieFace` -> [`Effect`]@.
|
||||
--
|
||||
-- In additon, the actor and target (respectively) are available in the context, to enable
|
||||
-- asking questions about those things
|
||||
class Question t where
|
||||
askQuestion :: ActingUnit -> TargettedUnit -> (t -> [Effect]) -> [Effect]
|
||||
|
||||
instance Question ActingUnit where
|
||||
askQuestion actor _ f = f actor
|
||||
|
||||
instance Question TargettedUnit where
|
||||
askQuestion _ target f = f target
|
||||
|
||||
-- | A function which can be converted into a sequence of effects
|
||||
--
|
||||
-- Used in `buildProtoEffect` to create a `ProtoEffect`
|
||||
class ProtoEffectF t where
|
||||
mkEffect :: ActingUnit -> TargettedUnit -> t -> [Effect]
|
||||
|
||||
instance ProtoEffectF f => ProtoEffectF [f] where
|
||||
mkEffect a t = (mkEffect a t =<<)
|
||||
|
||||
instance ProtoEffectF Effect where
|
||||
mkEffect _ _ = pure
|
||||
|
||||
instance ProtoEffectF ProtoEffect where
|
||||
mkEffect attacker target pe = mkEffect' attacker target pe
|
||||
|
||||
instance (ProtoEffectF a, Question q) => ProtoEffectF (q -> a) where
|
||||
mkEffect attacker target f = askQuestion attacker target (mkEffect attacker target <$> f)
|
||||
|
||||
data ProtoEffect = forall f. ProtoEffectF f => MkProtoEffect f
|
||||
|
||||
mkEffect' :: ActingUnit -> TargettedUnit -> ProtoEffect -> [Effect]
|
||||
mkEffect' attacker target (MkProtoEffect pe) = mkEffect attacker target pe
|
||||
|
||||
mkEffects' :: ActingUnit -> TargettedUnit -> [ProtoEffect] -> [Effect]
|
||||
mkEffects' a t = (mkEffect a t =<<)
|
||||
|
||||
inflictStatusEffect :: StatusEffect -> ProtoEffect
|
||||
inflictStatusEffect se _ = InflictStatusEffect se
|
||||
inflictStatusEffect se = MkProtoEffect $ InflictStatusEffect se
|
||||
|
||||
inflictTokens :: Num n => Token n -> n -> ProtoEffect
|
||||
inflictTokens tokenType tokenCount _ = InflictTokens tokenType tokenCount
|
||||
inflictTokens tokenType tokenCount = MkProtoEffect $ InflictTokens tokenType tokenCount
|
||||
|
||||
genericShift :: ForcedMoveType -> Natural -> ProtoEffect
|
||||
genericShift fmType amount puller = forcedMove fmType amount (owner puller) (Left puller)
|
||||
genericShift fmType amount = MkProtoEffect $ (\(ActingUnit puller) -> forcedMove fmType amount (owner puller) (Left puller))
|
||||
|
||||
push :: Natural -> ProtoEffect
|
||||
push = genericShift Push
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ module Units.Debug
|
|||
where
|
||||
|
||||
import GameModel
|
||||
( Armor(..)
|
||||
( Armor(..), ActingUnit
|
||||
, BaseStats(..)
|
||||
, CharacterIdentifier
|
||||
, Choice
|
||||
|
|
@ -12,6 +12,8 @@ import GameModel
|
|||
, Token(..), StatusEffect (..)
|
||||
, Hook(..), Effect(..)
|
||||
, Trigger(..), BoardState
|
||||
, TargettedUnit(..)
|
||||
, targettedUnit
|
||||
)
|
||||
|
||||
import Units.Components
|
||||
|
|
@ -23,6 +25,8 @@ import Units.Components
|
|||
, inflictStatusEffect
|
||||
)
|
||||
|
||||
import Lens.Micro
|
||||
|
||||
basic :: BaseStats
|
||||
basic = BaseStats
|
||||
{ name = "Basic Debug Unit"
|
||||
|
|
@ -34,7 +38,7 @@ basic = BaseStats
|
|||
, traits = []
|
||||
}
|
||||
|
||||
basicActions :: [CharacterIdentifier -> Choice]
|
||||
basicActions :: [ActingUnit -> Choice]
|
||||
basicActions =
|
||||
[ buildAttack $ AttackT
|
||||
{ tName = "Peashooter"
|
||||
|
|
@ -130,10 +134,11 @@ bloodShield = StatusEffect
|
|||
, seShowState = \n -> '(' : replicate n '*' ++ ")"
|
||||
}
|
||||
where
|
||||
damageHookEffect :: CharacterIdentifier -> BoardState -> Int -> CharacterIdentifier -> [Effect]
|
||||
damageHookEffect damagedUnit _ _ us = if damagedUnit == us then [InflictTokens VitalVulnr 1 us] else []
|
||||
damageHookDecrement :: CharacterIdentifier -> BoardState -> Int -> CharacterIdentifier -> Maybe Int
|
||||
damageHookEffect :: TargettedUnit -> BoardState -> Int -> CharacterIdentifier -> [Effect]
|
||||
damageHookEffect (TargettedUnit injuredUnit) _ _ us =
|
||||
[InflictTokens VitalVulnr 1 (TargettedUnit us) | injuredUnit == us ]
|
||||
damageHookDecrement :: TargettedUnit -> BoardState -> Int -> CharacterIdentifier -> Maybe Int
|
||||
damageHookDecrement damagedUnit _ n us
|
||||
| damagedUnit == us && n > 1 = Just $ pred n
|
||||
| damagedUnit == us = Nothing
|
||||
| damagedUnit ^. targettedUnit == us && n > 1 = Just $ pred n
|
||||
| damagedUnit ^. targettedUnit == us = Nothing
|
||||
| otherwise = Just n
|
||||
Loading…
Reference in a new issue