Change the representation of stats
This commit is contained in:
parent
69da0f1dfd
commit
70d8b0d1b0
GPG key ID:
A12F2C2FFDC3D847
|
|
@ -3,7 +3,8 @@ module Main (main) where
|
|||
import System.IO (hFlush, stdout)
|
||||
import Util (note)
|
||||
import GameModel (Point(..), Player(..), newBoard, BaseStats, BoardState, EnvTile (..), DieFace, bestOrWorst)
|
||||
import Units.Debug (basic, freeMoveTester)
|
||||
import Units.Debug (basic)
|
||||
import Units.Carcass (gunwight)
|
||||
import GameLogic (buildChoiceTree, ChoiceTree(..), ChoiceTree'(..), makeChoice, ctTree)
|
||||
|
||||
import Text.Read (readMaybe)
|
||||
|
|
@ -12,7 +13,7 @@ import Control.Monad (replicateM, void)
|
|||
import System.Random (randomIO)
|
||||
|
||||
initialPlacement :: Point -> Maybe (Player, BaseStats)
|
||||
initialPlacement = flip lookup [(Point 5, (Max, basic)), (Point 0, (Max, freeMoveTester)), (Point 23, (Min, basic)), (Point 22, (Min, freeMoveTester))]
|
||||
initialPlacement = flip lookup [(Point 5, (Max, basic)), (Point 0, (Max, gunwight)), (Point 23, (Min, basic)), (Point 22, (Min, gunwight))]
|
||||
|
||||
initialTerrain :: Point -> [EnvTile]
|
||||
initialTerrain (Point 4) = [Rough]
|
||||
|
|
|
|||
|
|
@ -28,6 +28,16 @@ import Lens.Micro
|
|||
import Safe (atMay)
|
||||
|
||||
import Debug.Trace
|
||||
import Mechanics (universalModifiers, globalHooks)
|
||||
import Data.Monoid (Any(getAny), getSum)
|
||||
|
||||
-- | A version of `computeStat_` using `universalModifiers` as global modifiers
|
||||
computeStat :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
computeStat = computeStat_ universalModifiers
|
||||
|
||||
-- | A version of `runHooks_` using `globalHooks` as the global hooks
|
||||
runHooks :: Trigger -> BoardState -> BoardState
|
||||
runHooks = runHooks_ globalHooks
|
||||
|
||||
data EngineState
|
||||
= PlayerChoice Player [Choice]
|
||||
|
|
@ -131,7 +141,7 @@ applyEffect StartTurn board = case (chooseCharacter board, chooseCharacter oppon
|
|||
if board ^. roundNumber == 6
|
||||
then board
|
||||
else nextRound board
|
||||
applyEffect (Event trigger) board = continue $ pushEffects (listHooks board trigger) board
|
||||
applyEffect (Event trigger) board = continue $ runHooks trigger board
|
||||
applyEffect (ChooseActMove cid) _ = unitChoice cid [moveFirst, actFirst]
|
||||
where
|
||||
moveFirst = mkChoice "Move first" [basicMove cid, ActOrMove cid, EndTurn cid]
|
||||
|
|
@ -144,7 +154,7 @@ applyEffect (InitMove (ProtoMovementSpecs {..}) cid) board = continue $ case adj
|
|||
Just movForced -> changeMovingUnit board cid <++ [Move (MovementSpecs {..}) cid]
|
||||
Nothing -> board
|
||||
where
|
||||
movFree = fromMaybe (computeStat board cid FreeMove) movFree'
|
||||
movFree = getAny $ computeStat board cid FreeMove
|
||||
adjustedFm = case movForced' of
|
||||
Nothing -> Just Nothing
|
||||
Just (Right p, fmType, forcer) -> Just $ Just (p, fmType, forcer)
|
||||
|
|
@ -238,7 +248,7 @@ applyEffect (ResolveAttack attacker attack defender) board = Roll actualDiceRoll
|
|||
validCover = if defenderElevated then [Wall] else [Wall, Elevation]
|
||||
hasCover = or $ (==) <$> validCover <*> coveringTerrain
|
||||
coverBonus = if not (melee attack) && hasCover then 1 else 0
|
||||
netDice = attackerDieBonus - (defenderDieBonus + coverBonus)
|
||||
netDice = getSum $ attackerDieBonus - (defenderDieBonus + coverBonus)
|
||||
actualDiceRolled = fromIntegral $ if netDice <= 0 then 2 else netDice
|
||||
keepHighest = netDice > 0
|
||||
toHit = maybe 1 getDefense defender'
|
||||
|
|
|
|||
129
src/GameModel.hs
129
src/GameModel.hs
|
|
@ -56,9 +56,8 @@ module GameModel
|
|||
, movL
|
||||
, dfL
|
||||
, armL
|
||||
, hooksL
|
||||
, traitsL
|
||||
, actionsL
|
||||
, statBonusL
|
||||
, instantiate
|
||||
, Character(..)
|
||||
, baseStats
|
||||
|
|
@ -94,7 +93,6 @@ module GameModel
|
|||
, isAlive
|
||||
, pushEffects
|
||||
, unitPosition
|
||||
, listHooks
|
||||
, terrainAt
|
||||
, characterAt
|
||||
, adjacentUnits
|
||||
|
|
@ -127,22 +125,33 @@ module GameModel
|
|||
, ProtoMovementSpecs(..)
|
||||
, basicMove
|
||||
, forcedMove
|
||||
, computeStat
|
||||
, allStatsAreMonoids
|
||||
, HasMonoidInstance
|
||||
, Hook(..)
|
||||
, hookTriggerL
|
||||
, hookEffectL
|
||||
, Modifier(..)
|
||||
, Trait(..)
|
||||
, traitNameL
|
||||
, traitHooksL
|
||||
, traitModifiersL
|
||||
, computeStat_
|
||||
, runHooks_
|
||||
) where
|
||||
|
||||
import Util (toMaybe, dup, secondClassLensNames, (??))
|
||||
|
||||
import Control.Applicative (liftA2, Alternative (..))
|
||||
import Control.Applicative (Alternative (..))
|
||||
import Control.Arrow ((>>>), Arrow (second))
|
||||
import Control.Monad (join, mfilter)
|
||||
import Control.Monad (join, mfilter, zipWithM)
|
||||
import Data.Ix (inRange)
|
||||
import Data.List (intersperse, elemIndex)
|
||||
import Data.List.NonEmpty as NonEmpty (cons, NonEmpty, singleton)
|
||||
import Data.Maybe (mapMaybe, catMaybes, fromMaybe)
|
||||
import Data.Maybe (mapMaybe, catMaybes)
|
||||
import Numeric.Natural (Natural)
|
||||
import Safe (headMay)
|
||||
import Lens.Micro
|
||||
import Data.Monoid (First)
|
||||
import Data.Monoid (Sum, Any)
|
||||
import Lens.Micro.TH (makeLenses, makeLensesWith, generateUpdateableOptics)
|
||||
import Lens.Micro.Extras (preview)
|
||||
import Data.Data ((:~:)(..))
|
||||
|
|
@ -292,6 +301,7 @@ data Trigger
|
|||
| TookDamage CharacterIdentifier
|
||||
| Died CharacterIdentifier Point
|
||||
| EndMove CharacterIdentifier
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OrthagonalDirection
|
||||
= North
|
||||
|
|
@ -519,9 +529,22 @@ otherPlayer Max = Min
|
|||
otherPlayer Min = Max
|
||||
|
||||
data Stat a where
|
||||
AttackDice :: Stat Int
|
||||
DefenseDice :: Stat Int
|
||||
FreeMove :: Stat Bool
|
||||
AttackDice :: Stat (Sum Int)
|
||||
DefenseDice :: Stat (Sum Int)
|
||||
FreeMove :: Stat Any
|
||||
|
||||
statEq :: Stat a -> Stat b -> Maybe (a :~: b)
|
||||
statEq AttackDice AttackDice = Just Refl
|
||||
statEq DefenseDice DefenseDice = Just Refl
|
||||
statEq FreeMove FreeMove = Just Refl
|
||||
statEq _ _ = Nothing
|
||||
|
||||
data HasMonoidInstance a = forall m. Monoid m => HasMonoidInstance (a :~: m)
|
||||
|
||||
allStatsAreMonoids :: Stat a -> HasMonoidInstance a
|
||||
allStatsAreMonoids AttackDice = HasMonoidInstance Refl
|
||||
allStatsAreMonoids DefenseDice = HasMonoidInstance Refl
|
||||
allStatsAreMonoids FreeMove = HasMonoidInstance Refl
|
||||
|
||||
data BaseStats = BaseStats
|
||||
{ name :: String
|
||||
|
|
@ -529,9 +552,36 @@ data BaseStats = BaseStats
|
|||
, mov :: Natural
|
||||
, df :: DieFace
|
||||
, arm :: Armor
|
||||
, hooks :: BoardState -> CharacterIdentifier -> Trigger -> [Effect]
|
||||
, traits :: [Trait]
|
||||
, actions :: [CharacterIdentifier -> Choice]
|
||||
, statBonus :: forall a. BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
}
|
||||
|
||||
-- | Some effect which is activated by some trigger event
|
||||
data Hook h = Hook
|
||||
{ hookTrigger :: Trigger -- ^ The trigger which should activate this effect
|
||||
-- | What this effect does. Recieves board & this character's CID
|
||||
, hookEffect :: BoardState -> h
|
||||
}
|
||||
|
||||
-- | A modifier which conditionally affects thet value of some stat for a unit
|
||||
data Modifier = forall a. Monoid a => Modifier
|
||||
{ modifierStat :: Stat a -- ^ Which stat this modifier effects
|
||||
-- | What the effects of this modifier are
|
||||
, modifierEffect :: BoardState -> CharacterIdentifier -> a
|
||||
}
|
||||
|
||||
queryModifier :: BoardState -> CharacterIdentifier -> Stat a -> Modifier -> a
|
||||
queryModifier board cid queryStat (Modifier {..}) = case queryStat `statEq` modifierStat of
|
||||
Just Refl -> modifierEffect board cid
|
||||
Nothing -> case allStatsAreMonoids queryStat of HasMonoidInstance Refl -> mempty
|
||||
|
||||
-- | A passive trait on a unit
|
||||
-- Can affect a unit or surrounding units by directly and conditionally modifying that
|
||||
-- units stats, or by running certain 'Effect's on a given trigger
|
||||
data Trait = Trait
|
||||
{ traitName :: String -- ^ The name of this trait, e.g. "Formation"
|
||||
, traitHooks :: [Hook (CharacterIdentifier -> [Effect])] -- ^ Any hooks which this trait needs
|
||||
, traitModifiers :: [Modifier] -- ^ Any modifiers this trait imposes
|
||||
}
|
||||
|
||||
instance Show BaseStats where
|
||||
|
|
@ -645,6 +695,10 @@ makeLensesWith (secondClassLensNames & generateUpdateableOptics .~ False) ''Base
|
|||
|
||||
makeLensesWith secondClassLensNames ''MovementSpecs
|
||||
|
||||
makeLensesWith secondClassLensNames ''Hook
|
||||
|
||||
makeLensesWith secondClassLensNames ''Trait
|
||||
|
||||
instantiate :: BaseStats -> Character
|
||||
instantiate stats = Character stats False noTokens & tokenCount . ofToken Health .~ hp stats
|
||||
|
||||
|
|
@ -682,18 +736,39 @@ untapped = not . _movedThisRound
|
|||
untap :: Character -> Character
|
||||
untap = movedThisRound .~ False
|
||||
|
||||
computeStat :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
computeStat board cid stat = case stat of
|
||||
AttackDice -> 1 + elevationBonus + fromMaybe 0 specialtyBonus
|
||||
DefenseDice -> 0 + elevationBonus + fromMaybe 0 specialtyBonus
|
||||
FreeMove -> fromMaybe False specialtyBonus
|
||||
-- | Compute a stat for a unit by accumulating the modifiers for the stat in all places
|
||||
--
|
||||
-- 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
|
||||
HasMonoidInstance Refl ->
|
||||
let
|
||||
queryStatsL = each . to (queryModifier board cid stat)
|
||||
globalBonus = globalModifiers ^. queryStatsL
|
||||
traitBonus = board ^. ixCharacter cid . baseStats . traitsL . each . traitModifiersL . queryStatsL
|
||||
in globalBonus <> traitBonus
|
||||
|
||||
-- | Activate all of the relevant hooks on the board
|
||||
--
|
||||
-- Searches through all hooks in traits and global hooks, accumulates all their effects,
|
||||
-- then adds all the resulting effects to the effect stack. Similar to `computeStat_`,
|
||||
-- this is additionall searches so called global hooks, but only recognizes global hooks
|
||||
-- passed as an argument.
|
||||
runHooks_ :: [Hook [Effect]] -> Trigger -> BoardState -> BoardState
|
||||
runHooks_ globalHooks trigger board = board <++ characterEffects <++ globalEffects
|
||||
where
|
||||
statBonuses = ixCharacter cid . baseStats . statBonusL
|
||||
specialtyBonus = case board ^? statBonuses of
|
||||
Just statB -> Just $ statB board cid stat
|
||||
Nothing -> Nothing
|
||||
elevationBonus :: Int
|
||||
elevationBonus = if isElevated board cid then 1 else 0
|
||||
filterActivatedL :: Traversal' (Hook a) (Hook a)
|
||||
filterActivatedL = filtered ((==trigger) . hookTrigger)
|
||||
unitHooksL :: SimpleFold Character (BoardState -> CharacterIdentifier -> [Effect])
|
||||
unitHooksL = baseStats . traitsL . each . traitHooksL . each . filterActivatedL . hookEffectL
|
||||
charRunHooks :: (CharacterIdentifier, Character) -> [Effect]
|
||||
charRunHooks (cid, c) =
|
||||
(c ^. unitHooksL) board cid
|
||||
characterEffects :: [Effect]
|
||||
characterEffects = board ^. enumerateUnits . to charRunHooks
|
||||
globalEffects :: [Effect]
|
||||
globalEffects = (globalHooks ^. each . filterActivatedL . hookEffectL) board
|
||||
|
||||
instance Show BoardState where
|
||||
show board = join (intersperse "\n" showTiles) ++ '\n':showRound ++ "\n" ++ showCharacters
|
||||
|
|
@ -893,12 +968,6 @@ unitPosition (BoardState {_tiles}) cid = headMay $ catMaybes $ zipWith aux [0..]
|
|||
| potentialCid == Just cid = Just $ Point p
|
||||
| otherwise = Nothing
|
||||
|
||||
listHooks :: BoardState -> Trigger -> [Effect]
|
||||
listHooks boardState = mconcat <$> traverse characterHooks (boardState ^.. enumerateUnits)
|
||||
where
|
||||
characterHooks :: (CharacterIdentifier, Character) -> Trigger -> [Effect]
|
||||
characterHooks (cid, c) = hooks (_baseStats c) boardState cid
|
||||
|
||||
atPoint :: Point -> Traversal' BoardState (Maybe CharacterIdentifier, [EnvTile])
|
||||
atPoint p = tiles . ixp p
|
||||
where
|
||||
|
|
|
|||
32
src/Mechanics.hs
Normal file
32
src/Mechanics.hs
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
module Mechanics
|
||||
( universalModifiers
|
||||
, globalHooks
|
||||
)
|
||||
where
|
||||
|
||||
import GameModel
|
||||
(BoardState, CharacterIdentifier, Modifier (..), Stat (..), isElevated, Hook, Effect)
|
||||
|
||||
import Data.Monoid (Sum)
|
||||
|
||||
universalModifiers :: [Modifier]
|
||||
universalModifiers =
|
||||
[ elevationBonus AttackDice
|
||||
, elevationBonus DefenseDice
|
||||
, attackDiceBase
|
||||
]
|
||||
|
||||
elevationBonus :: Stat (Sum Int) -> Modifier
|
||||
elevationBonus modifierStat = Modifier {..}
|
||||
where
|
||||
modifierEffect :: BoardState -> CharacterIdentifier -> Sum Int
|
||||
modifierEffect board cid = if isElevated board cid then 1 else 0
|
||||
|
||||
attackDiceBase :: Modifier
|
||||
attackDiceBase = Modifier {..}
|
||||
where
|
||||
modifierStat = AttackDice
|
||||
modifierEffect = const $ const 1
|
||||
|
||||
globalHooks :: [Hook [Effect]]
|
||||
globalHooks = []
|
||||
|
|
@ -15,6 +15,8 @@ import GameModel
|
|||
, Stat(..)
|
||||
, Token(..)
|
||||
, Trigger(..)
|
||||
, Trait(..)
|
||||
, Modifier(..)
|
||||
)
|
||||
import Units.Components
|
||||
( AttackT(..)
|
||||
|
|
@ -29,17 +31,10 @@ gunwight = BaseStats
|
|||
, mov = 2
|
||||
, df = 4
|
||||
, arm = NoArmor
|
||||
, hooks = gunwightHooks
|
||||
, actions = gunwightActions
|
||||
, statBonus = gunwightStatBonuses
|
||||
, traits = [formation]
|
||||
}
|
||||
|
||||
gunwightHooks :: BoardState -> CharacterIdentifier -> Trigger -> [Effect]
|
||||
gunwightHooks board cid TurnStart = []
|
||||
gunwightHooks board cid (TookDamage _) = []
|
||||
gunwightHooks board cid (Died _ _) = []
|
||||
gunwightHooks board cid (EndMove _) = []
|
||||
|
||||
gunwightActions :: [CharacterIdentifier -> Choice]
|
||||
gunwightActions =
|
||||
[ buildAttack $ AttackT
|
||||
|
|
@ -64,7 +59,15 @@ gunwightActions =
|
|||
}
|
||||
]
|
||||
|
||||
gunwightStatBonuses :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
gunwightStatBonuses board cid AttackDice = if adjacentAllies board cid /= Just [] then 1 else 0
|
||||
gunwightStatBonuses _ _ DefenseDice = 0
|
||||
gunwightStatBonuses _ _ FreeMove = False
|
||||
formation :: Trait
|
||||
formation = Trait
|
||||
{ traitName = "Formation"
|
||||
, traitHooks = []
|
||||
, traitModifiers = [formationModifier]
|
||||
}
|
||||
where
|
||||
formationF board cid = if adjacentAllies board cid /= Just [] then 1 else 0
|
||||
formationModifier = Modifier
|
||||
{ modifierStat = AttackDice
|
||||
, modifierEffect = formationF
|
||||
}
|
||||
|
|
@ -1,21 +1,17 @@
|
|||
module Units.Debug
|
||||
( basic
|
||||
, freeMoveTester)
|
||||
)
|
||||
where
|
||||
|
||||
import GameModel
|
||||
( Armor(..)
|
||||
, BaseStats(..)
|
||||
, BoardState
|
||||
, CharacterIdentifier
|
||||
, Choice
|
||||
, DamageType(..)
|
||||
, Effect(..)
|
||||
, Stat(..)
|
||||
, Token(..)
|
||||
, Trigger(..), ixCharacter, tokenCount, ofToken
|
||||
, forcedMove, ForcedMoveType (Pull), Player (..)
|
||||
)
|
||||
|
||||
import Units.Components
|
||||
( AttackT(..)
|
||||
, anyTarget
|
||||
|
|
@ -23,7 +19,6 @@ import Units.Components
|
|||
, SelfAbilityT(..)
|
||||
, mkSelfAbility, inflictTokens, pull, push
|
||||
)
|
||||
import Lens.Micro
|
||||
|
||||
basic :: BaseStats
|
||||
basic = BaseStats
|
||||
|
|
@ -32,17 +27,10 @@ basic = BaseStats
|
|||
, mov = 4
|
||||
, df = 4
|
||||
, arm = NoArmor
|
||||
, hooks = basicHooks
|
||||
, actions = basicActions
|
||||
, statBonus = basicStatBonuses
|
||||
, traits = []
|
||||
}
|
||||
|
||||
basicHooks :: BoardState -> CharacterIdentifier -> Trigger -> [Effect]
|
||||
basicHooks _ _ TurnStart = []
|
||||
basicHooks _ _ (TookDamage _) = []
|
||||
basicHooks _ _ (Died _ _) = []
|
||||
basicHooks _ _ (EndMove _) = []
|
||||
|
||||
basicActions :: [CharacterIdentifier -> Choice]
|
||||
basicActions =
|
||||
[ buildAttack $ AttackT
|
||||
|
|
@ -118,37 +106,3 @@ basicActions =
|
|||
, tEffects = [inflictTokens StrWeak 1]
|
||||
}
|
||||
]
|
||||
|
||||
basicStatBonuses :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
basicStatBonuses _ _ AttackDice = 0
|
||||
basicStatBonuses _ _ DefenseDice = 0
|
||||
basicStatBonuses _ _ FreeMove = False
|
||||
|
||||
freeMoveTester :: BaseStats
|
||||
freeMoveTester = BaseStats
|
||||
{ name = "Free Move Debug Unit"
|
||||
, hp = 4
|
||||
, mov = 4
|
||||
, df = 1
|
||||
, arm = NoArmor
|
||||
, hooks = freeMoveHooks
|
||||
, actions = freeMoveActions
|
||||
, statBonus = freeMoveStatBonuses
|
||||
}
|
||||
|
||||
freeMoveHooks :: BoardState -> CharacterIdentifier -> Trigger -> [Effect]
|
||||
freeMoveHooks _ _ TurnStart = []
|
||||
freeMoveHooks _ _ (TookDamage _) = []
|
||||
freeMoveHooks _ _ (Died _ _) = []
|
||||
freeMoveHooks _ _ (EndMove _) = []
|
||||
|
||||
freeMoveActions :: [CharacterIdentifier -> Choice]
|
||||
freeMoveActions =
|
||||
[
|
||||
]
|
||||
|
||||
freeMoveStatBonuses :: BoardState -> CharacterIdentifier -> Stat a -> a
|
||||
freeMoveStatBonuses _ _ AttackDice = 0
|
||||
freeMoveStatBonuses _ _ DefenseDice = 0
|
||||
freeMoveStatBonuses board cid FreeMove = -- Has free movement when below max health
|
||||
maybe True (<4) $ board ^? ixCharacter cid . tokenCount . ofToken Health
|
||||
Loading…
Reference in a new issue