| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Game
Synopsis
- allEnemySpots :: Card -> [Card]
- allTargets :: [Target]
-
data Animation
- = Application Player Target (Card Core)
- | NoAnimation
- | Fadeout
- | Message [MessageText] Nat
- appliesTo :: T Core -> ID -> Player -> Target -> Bool
- applyFearNTerror :: T Core -> Player -> (T Core, T UI)
- applyFillTheFrontline :: T Core -> Player -> T Core
- applyPlagueM :: MonadWriter (T UI) m => T Core -> Player -> Player -> m (T Core)
- attackOrder :: Player -> [Card]
- cardsToDraw :: T Core -> Player -> Bool -> [DrawSource]
- drawCard :: Model -> T Core -> Player -> DrawSource -> (Model, T Core, T UI)
- drawCards :: Model -> T Core -> Player -> [DrawSource] -> (Model, T Core, T UI)
- enemySpots :: Creature Core -> Card -> EnemySpots [Card]
- idToHandIndex :: T Core -> Player -> ID -> Maybe HandIndex
-
data DrawSource
- = Native
- | CardDrawer Player Card
- eventToAnim :: MonadError Text m => Model -> T Core -> Event -> m Animation
- data EnemySpots a
- data Event
- keepEffectfull :: Model -> Playable [Event] -> [Event]
- maybePlay :: Model -> Playable Event -> Maybe (Model, T Core, Maybe Event)
- meetsRequirement :: Item -> Creature Core -> Bool
- data MessageText
- mkPlayable :: T Core -> e -> T -> Playable e
- nextAttackSpot :: T Core -> Player -> Maybe Card -> Maybe Card
- data Place
- data Playable e = Playable {}
- data Result e = Result {}
- play :: Model -> Playable Event -> Either Text (Result (Maybe Event))
- playE :: MonadError Text m => Model -> Playable Event -> m (Model, T Core, T UI, Maybe Event)
- playAll :: Model -> Playable [Event] -> Either Text (Result ())
- playAllE :: MonadError Text m => Model -> Playable [Event] -> m (Model, T Core, T UI)
- toSpot :: Place -> Player
- toSpots :: EnemySpots [Card] -> [Card]
- tryPlayM :: MonadError Text m => MonadWriter (T UI) m => MonadState Model m => Playable Event -> m (Possible (T Core, Maybe Event))
-
data StatChange = StatChange {
- attackDiff :: Nat
- hpDiff :: Nat
- transferCards :: Model -> T Core -> Player -> (Model, T Core, T UI)
- data Target
- whichPlayerTarget :: ID -> WhichPlayerTarget
- data WhichPlayerTarget
Documentation
Spots that can be attacked from a spot. Spot as argument is in one player part while spots returned are in the other player part. The order in the result matters, the first element is the first spot attacked, then the second element is attacked if the first spot is empty or if the creature can attack multiple spots for some reasons.
allTargets :: [Target] #
All possible targets
An animation that makes sense at the Game level. If you
consider extending this variant, consider whether it would be
be better in Board.T 'UI
Constructors
| Application Player Target (Card Core) | Player plays the given card played on a target. This is used for example
to display |
| NoAnimation | |
| Fadeout | Game view should fadeout |
| Message [MessageText] Nat | Message to show centered. The |
Instances
appliesTo :: T Core -> ID -> Player -> Target -> Bool #
board id pSpot target holds iff player at pSpot can play card id
on target
attackOrder :: Player -> [Card] #
The order in which cards attack
cardsToDraw :: T Core -> Player -> Bool -> [DrawSource] #
The cards to draw, the Boolean indicates whether to bound by the stack's length or not
Arguments
| :: Creature Core | The attacker |
| -> Card | Where the attack is |
| -> EnemySpots [Card] |
Spots that can be attacked by a creature. Spot as argument is in one player part while spots returned are in the other player part. The order in the result matters, the first element is the first spot attacked, then the second element is attacked if the first spot is empty or if the creature can attack multiple spots for some reasons.
idToHandIndex :: T Core -> Player -> ID -> Maybe HandIndex #
The index of the card with this ID, in the hand of the
player at the given spot
data DrawSource #
The reason for drawing a card
Constructors
| Native | Drawing one of the [nbDrawCards] cards allowed |
| CardDrawer Player Card | Drawing a card because of a creature with the [DrawCard] skill at the given position |
Instances
| Eq DrawSource # | |
Defined in Game | |
| Ord DrawSource # | |
Defined in Game Methods compare :: DrawSource -> DrawSource -> Ordering # (<) :: DrawSource -> DrawSource -> Bool # (<=) :: DrawSource -> DrawSource -> Bool # (>) :: DrawSource -> DrawSource -> Bool # (>=) :: DrawSource -> DrawSource -> Bool # max :: DrawSource -> DrawSource -> DrawSource # min :: DrawSource -> DrawSource -> DrawSource # | |
| Show DrawSource # | |
Defined in Game Methods showsPrec :: Int -> DrawSource -> ShowS # show :: DrawSource -> String # showList :: [DrawSource] -> ShowS # | |
eventToAnim :: MonadError Text m => Model -> T Core -> Event -> m Animation #
Translates an Event into an animation displayed in the
middle of the Board.
data EnemySpots a #
Type to handle various custom skills when resolving attacks
Constructors
| Ace | Creature has |
| Imprecise | Creature has |
| Spots a | A creature without |
Instances
| Functor EnemySpots # | |
Defined in Game Methods fmap :: (a -> b) -> EnemySpots a -> EnemySpots b # (<$) :: a -> EnemySpots b -> EnemySpots a # | |
If you add an event that triggers automatically, you should likely
extend mkEvents
Constructors
| ApplyAssassins Player | Apply assassins of the creatures at the given |
| ApplyBleed Player | Apply bleed on the creatures at the given |
| ApplyBrainless Player | Apply brainless of the creatures at the given |
| ApplyChurch Player | Apply church of the creatures at the given |
| ApplyCreateForest Player | Apply the create forest spell of the creatures at the given |
| ApplyFearNTerror Player | Apply fear caused by the creatures at the given |
| ApplyGrowth Player | Apply growth of the creatures at the given |
| ApplyKing Player | Apply king of the creatures at the given |
| Attack Player Card Bool Bool | A card attacks at the given spot. The first Boolean indicates
whether the next spot (as defined by |
| FillTheFrontline Player | Ranged creatures with the |
| NoPlayEvent | A Nothing case, for convenience |
| PEvent Place | A |
Instances
keepEffectfull :: Model -> Playable [Event] -> [Event] #
'keepEffectfull board es' returns the elements of es
that have an effect. Elements of es are played in sequence.
maybePlay :: Model -> Playable Event -> Maybe (Model, T Core, Maybe Event) #
Try to play an event. If the event cannot be played or a hard error
occurs (MonadError Text _ in other functions of this API), simply return Nothing.
data MessageText #
Constructors
| Text Text | Simple text to display |
| Image Filepath | Constructor to display an image. The image should be fine
for passing to |
Instances
| Eq MessageText # | |
Defined in Game | |
| Generic MessageText # | |
| type Rep MessageText # | |
Defined in Game
type Rep MessageText = D1 (MetaData "MessageText" "Game" "main" False) (C1 (MetaCons "Text" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) :+: C1 (MetaCons "Image" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Filepath))) | |
mkPlayable :: T Core -> e -> T -> Playable e #
To allow callers to hide the implementation of Playable, to avoid
fields names conflicts.
nextAttackSpot :: T Core -> Player -> Maybe Card -> Maybe Card #
nextAttackSpot b pSpot cSpot returns the spots to attack after cSpot.
If cSpot is Nothing, the first spot in the order is considered; if
cSpot is Just _, then spots after cSpot are considered.
If pre End Turn events are changed in Move, this function may have
to be adapted to play the events beforehand. This should be discovered
automatically, as this property is checked with a PBT.
Placing events. These events are the ones that the AI generates (as
opposed to the more general Event type).
Constructors
| Place Player Target HandIndex | Player puts a card from his hand on its part of the board. First argument is the player, second argument is the target, third argument is the card being played. |
| Place' Player Target ID | AI puts a card from his hand. This constructor has better
testing behavior than |
Instances
| Eq Place # | |
| Show Place # | |
| Generic Place # | |
| type Rep Place # | |
Defined in Game
type Rep Place = D1 (MetaData "Place" "Game" "main" False) (C1 (MetaCons "Place" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Player) :*: (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Target) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 HandIndex))) :+: C1 (MetaCons "Place'" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Player) :*: (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Target) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ID)))) | |
The input type to most play* functions
Instances
| With (Playable a) a # | |
| Contains (Playable a) a # | |
| With (Playable a) (T Core) # | |
| Contains (Playable a) (T Core) # | |
| (With (Playable a) (T Core), With (Playable a) a) => With (Playable a) (T Core, a) # | |
| (Contains (Playable a) (T Core), Contains (Playable a) a) => Contains (Playable a) (T Core, a) # | |
The result of playing game events. If you add a field, extend
the Eq instance below. TODO @smelc find a better name.
playAll :: Model -> Playable [Event] -> Either Text (Result ()) #
Play a list of events, playing newly produced events as they are being
produced. That is why, contrary to play, this function doesn't return
events: it consumes them all eagerly. See playAllM for the monad version
playAllE :: MonadError Text m => Model -> Playable [Event] -> m (Model, T Core, T UI) #
Like playAll, but in the error monad. This function skips unapplicable
events. That is why its return type doesn't have Impossible.
toSpots :: EnemySpots [Card] -> [Card] #
tryPlayM :: MonadError Text m => MonadWriter (T UI) m => MonadState Model m => Playable Event -> m (Possible (T Core, Maybe Event)) #
data StatChange #
A change in stats of a creature. Using Nat for now because it suffices
for the use cases. But really it could be a Int, it just makes apply harder.
Constructors
| StatChange | |
Fields
| |
Instances
| Eq StatChange # | |
Defined in Game | |
| Show StatChange # | |
Defined in Game Methods showsPrec :: Int -> StatChange -> ShowS # show :: StatChange -> String # showList :: [StatChange] -> ShowS # | |
| Generic StatChange # | |
| Semigroup StatChange # | |
Defined in Game Methods (<>) :: StatChange -> StatChange -> StatChange # sconcat :: NonEmpty StatChange -> StatChange # stimes :: Integral b => b -> StatChange -> StatChange # | |
| Monoid StatChange # | |
Defined in Game Methods mempty :: StatChange # mappend :: StatChange -> StatChange -> StatChange # mconcat :: [StatChange] -> StatChange # | |
| type Rep StatChange # | |
Defined in Game
type Rep StatChange = D1 (MetaData "StatChange" "Game" "main" False) (C1 (MetaCons "StatChange" PrefixI True) (S1 (MetaSel (Just "attackDiff") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Nat) :*: S1 (MetaSel (Just "hpDiff") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Nat))) | |
On what a card can be applied
Constructors
| PlayerTarget Player | Neutral card applies to all in place cards of a player |
| CardTarget Player Card | Creature card placed at given spot or Neutral card applies to a given in place card of a player |
Instances
| Eq Target # | |
| Ord Target # | |
| Show Target # | |
| Generic Target # | |
| type Rep Target # | |
Defined in Game
type Rep Target = D1 (MetaData "Target" "Game" "main" False) (C1 (MetaCons "PlayerTarget" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Player)) :+: C1 (MetaCons "CardTarget" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Player) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Card))) | |
data WhichPlayerTarget #
Whether a card makes sense on the playing player or the opponent. We could even try both, but we don't do that for now