Writing a text adventure using functional programming with F# Part 2
For reference, the full project can be found here.
In my previous article I had used my orchestration system to build a simple text adventure with a nonlinear narrative as a console application. For the next step, I decided that my game should have some RPG combat. As before, I took inspiration from classic games of my childhood such as Final Fantasy.
This style of combat is typically turn-based; a player waits their turn, chooses an action, and then waits while the other combatants take their turns. Its a relatively simple system that can allow for some quite sophisticated gameplay. Of course this remains a fun exploratory / proof of concept project rather than anything approaching an actual game, so don’t hold your breath for anything particularly groundbreaking or even particularly fleshed out gameplay-wise.
Writing turn based combat in a console application wouldn’t have been too difficult, but it felt like a bit of a cop-out. I wanted my combat to have at least some immediacy. To accomplish this I wanted to write my own version of the Final Fantasy series classic Active Time Battle (ATB) system. Under this system, each combatant has a cooldown timer that fills up between their turns. Once the cooldown timer is finished, the combatant can choose an action and take their turn. Crucially, the other combatants cooldown timers are not affected by whether or not a player has chosen an action or not. This puts a bit of time pressure on the player when choosing an action that adds the all-important sense of immediacy to the combat.
Initial infrastructure
Accomplishing this would be impossible in a console application though, or at least very awkward, because console applications block between inputs by their nature. So I decided it was time to upgrade my games infrastructure. To this end I chose the Monogame framework; an open source .NET game framework. I was attracted by the fact that it was a .NET library, which meant I was free to work in F#, and the fact that it’s relatively barebones. For what i’m trying to achieve, a full game engine would be complete overkill. Generally I prefer not to fill my projects with external dependencies, but for the sake of expediency I used the Myra library to take care of things like displaying text and progress bars.
The way monogame works is that you implement your game as a class the inherits from a given Game base class and then overrides a set of methods to implement the game logic. There are two methods, Initialise and LoadContent that are called at the start or the game, and then two methods Update and Draw that are called on loop multiple times a second to take care of maintaining the game state and rendering. I chose to implement the Monogame integration as a C# project as all the monogame project templates are for C# projects. The C# class than calls to my libraries written in F# for the game logic. Admittedly it should be quite easy to make the project run entirely with F#, but i’m not a huge fan of fighting frameworks to get them to work with F#. In general I prefer to work with F# in a way that complements C# and its many tools and libraries rather than competes with it.
Performance considerations
I’m not aiming for bleeding edge performance in this project, but even so it’s worth considering potential issues that may arise and how that will influence the architecture from a broad scope before diving into the details. Functional programming makes heavy use of immutability and polymorphism in a way that abstracts the underlying machine quite a lot. My orchestration code goes even further, quite liberally allocating lists and running things under the hood. This is fine in most cases, as computers are pretty fast, but one area where it is very much not fine is in the hot path of a render loop, unfortunately here performance matters.
To clarify the problem, its not that all invocations of the core loop function need to be perfectly optimised, just that I can’t call expensive operations on every invocation. It helps to consider an abstract notion of domain events vs update events. Update events are the invocations that happen multiple times a second, domain events by contrast refer to the events that happen that define the course of the game on a human timescale; so starting a game, loading a save, choosing an action etc. In order to not risk performance issues caused by excessive allocations to the garbage collector, I need to be careful to ensure my state machines only run abstractly over domain events, and try and avoid expensive operations over update events.
This means that to a certain extent mutations are unavoidable; staying in the comfortable bubble of functional programming is not an option. Fortunately F# is quite a flexible and pragmatic language; I can fairly easily switch to a more procedural model when writing code for the render loop. It is for this reason that much of the project code makes use of more traditionally object-oriented features such as classes with mutable state. I have tried to maintain a boundary between the pure logic of my game which is more pure functional (as represented by the Core project), and the more infrastructure influenced implementation.
Screen management
The game can be seen broadly as a progression through a set of different screens, each one with its own set of interactions. The various screens are:
- Title
- Main menu that provides the option to load a save or start a new game
- Game screen where essentially the story plays out
- Menu screen where the player can save and load their game
- Battle
- Game over
The progression looks like this:
In other words what we have here is another state machine. So I just need to create a new orchestration that manages the screen journey.
Each screen has its own Inititalise, Update and Render method, and is represented by the IScreen interface:
[<AllowNullLiteral>]
type IScreen =
abstract member Initialise: unit -> unit
abstract member OnUpdate: GameTime -> unit
abstract member OnRender: unit -> unit(I’m allowing nulls here as these will be consumed from C#)
The screen journey orchestration is managed by a ScreenManager class:
[<AllowNullLiteral>]
type ScreenManager (coordination) =
let screen =
let { Result = screens } = coordination None
screens |> List.tryExactlyOne
member this.Screen with get() : IScreen =
if screen.IsSome then screen.Value else null
member this.DoStep (e: ScreenJourneyEvent) =
let { Next = next } = coordination (Some e)
next
|> Option.map ScreenManager
|> Option.defaultValue nullSo the usage of orchestrations here is little constrained; The screen journey is assumed to only return one screen at a time. If it returns more than one an exception is thrown. The ScreenManager essentially provides a C# friendly interface to interact with the orchestration, and memoizes the call to get the next screen.
Now we have enough context to understand the full game class:
public class Game1 : Game
{
private GraphicsDeviceManager graphics;
private SpriteBatch? spriteBatch;
private ScreenManager? screenManager;
public Game1()
{
this.graphics = new GraphicsDeviceManager(this);
graphics.IsFullScreen = false;
graphics.PreferredBackBufferWidth = 800;
graphics.PreferredBackBufferHeight = 600;
Content.RootDirectory = "Content";
IsMouseVisible = true;
}
protected override void Initialize()
{
base.Initialize();
}
private void OnScreenJourneyEvent(Screens.ScreenJourneyEvent e)
{
this.screenManager = this.screenManager?.DoStep(e);
this.screenManager?.Screen?.Initialise();
}
protected override void LoadContent()
{
this.spriteBatch = new SpriteBatch(GraphicsDevice);
MyraEnvironment.Game = this;
this.screenManager = new ScreenManager(ScreenJourney.ScreenJouney(this.OnScreenJourneyEvent));
this.screenManager?.Screen?.Initialise();
}
protected override void Update(GameTime gameTime)
{
this.screenManager?.Screen?.OnUpdate(gameTime);
base.Update(gameTime);
}
protected override void Draw(GameTime gameTime)
{
GraphicsDevice.Clear(Color.Black);
this.screenManager?.Screen?.OnRender();
base.Draw(gameTime);
}
}So as we can see, the Game class just sets up the Myra resources and forwards the various Monogame hook method calls to the relevant screen. Simple.
The screen orchestration takes screen journey events and returns IScreens. Because I am not returning immutable types, I am not strictly doing pure functional programming, but having screens be mutable objects prevents the need for excessive allocations on the render loop. It’s worth remembering that F# isn’t Haskell, this kind of mixing object-oriented programming with functional programming is perfectly fine.
Now lets take a look at the screen journey orchestration itself:
type ScreenJourneyEvent =
| TitleScreenDone
| StartLoadSelected of string option
| OpenGameScreen of GameState
| OpenMenuScreen of GameState
| OpenBattleScreen of Story.State * GameState
| OpenGameOverScreen of GameState
let rec mainLoop desktop updateFn gameState = orchestration {
let! screenEvent =
event (function
| OpenMenuScreen state -> Some (OpenMenuScreen state)
| OpenBattleScreen (battleState, gameState) -> Some (OpenBattleScreen (battleState, gameState))
| _ -> None)
|> raiseToOrchestrationWithActions [new Screens.GameScreen(desktop, updateFn, gameState) :> IScreen]
let! gameState, isGameOver =
match screenEvent with
| OpenMenuScreen gameState ->
event (function | OpenGameScreen state -> Some (state, false) | _ -> None)
|> raiseToOrchestrationWithActions [new Screens.MenuScreen(desktop, updateFn, gameState, Story.story) :> IScreen]
| OpenBattleScreen (battleState, gameState) ->
event (
function
| OpenGameScreen state -> Some (state, false)
| OpenGameOverScreen state -> Some (state, true)
| _ -> None)
|> raiseToOrchestrationWithActions [new BattleScreen(desktop, updateFn, battleState, gameState) :> IScreen]
| _ -> failwith "Unexpected screen event"
return!
if isGameOver then
orchestration {
do! event (function | _ -> None)
|> raiseToOrchestrationWithActions [new Screens.GameOverScreen(desktop) :> IScreen]
}
else mainLoop desktop updateFn gameState
}
let ScreenJouney updateFn =
orchestration {
let desktop = new Desktop()
do! event (function | TitleScreenDone -> Some () | _ -> None)
|> raiseToOrchestrationWithActions [new Screens.StartMenu(desktop, updateFn) :> IScreen]
let! fileName =
event (function | StartLoadSelected x -> Some x | _ -> None)
|> raiseToOrchestrationWithActions [new Screens.StartOrLoadMenu(desktop, updateFn) :> IScreen]
let gameState: GameState.GameState option =
match fileName with
| Some fileName -> GameState.Load(fileName, Story.story)
| None -> Some (GameState.New(Story.story))
do! match gameState with
| Some gameState -> mainLoop desktop updateFn gameState
| None -> orchestration { return () }
return ()
}
|> OrchestrationCE.Coordination.collect (function | Break x -> x | _ -> [])Here we can see the full screen journey in a reasonably readable style. The updateFn passed to the various screens is a method in the Game class that enables the individual screens to fire the events to trigger screen transitions. The orchestration ensures that the new screen is passed any state that it needs.
And here are some examples of actual screen implementations:
type StartMenu (desktop: Desktop, updateScreenFn: System.Action<ScreenJourneyEvent>) =
let root =
let panel = Panel(VerticalAlignment = VerticalAlignment.Center, HorizontalAlignment = HorizontalAlignment.Center)
let stack = VerticalStackPanel()
let positionedText = Label(HorizontalAlignment = HorizontalAlignment.Center, Text = "Echoes of Elaria: The Crystals of Destiny")
let pressEnterText = Label(HorizontalAlignment = HorizontalAlignment.Center, Text = "Press Enter");
stack.Widgets.Add(positionedText);
stack.Widgets.Add(pressEnterText);
panel.Widgets.Add(stack);
panel
interface IScreen with
member this.Initialise () =
desktop.Root <- root
member this.OnUpdate gameTime =
if (Keyboard.GetState().IsKeyDown(Keys.Enter))
then updateScreenFn.Invoke(TitleScreenDone)
member this.OnRender () =
desktop.Render()
type StartOrLoadMenu (desktop: Desktop, updateScreenFn: System.Action<ScreenJourneyEvent>) =
let onLoadComplete (dialog: FileDialog) =
if dialog.Result
then updateScreenFn.Invoke(StartLoadSelected (Some dialog.FilePath))
let root =
let dialog = FileDialog(FileDialogMode.OpenFile, Filter="*.json")
dialog.Closed.Add(fun _ -> onLoadComplete dialog)
let panel = Panel(VerticalAlignment = VerticalAlignment.Center, HorizontalAlignment = HorizontalAlignment.Center)
let stack = VerticalStackPanel()
let startNewGame = Button(Content = Label(Text = "Start new game"), HorizontalAlignment = HorizontalAlignment.Center)
startNewGame.TouchDown.Add(fun _ -> updateScreenFn.Invoke(StartLoadSelected None))
let loadGame = Button(Content = Label(Text = "Load game"), HorizontalAlignment = HorizontalAlignment.Center)
loadGame.TouchDown.Add(fun _ -> dialog.ShowModal(desktop))
stack.Widgets.Add(startNewGame);
stack.Widgets.Add(loadGame);
panel.Widgets.Add(stack);
panel
interface IScreen with
member this.Initialise () =
desktop.Root <- root
member this.OnUpdate gameTime =
()
member this.OnRender () =
desktop.Render()I won’t bother going through every screen as the principle is basically the same across all of them. The screen class sets up the Myra desktop for that screen and provides hooks for initialising, update and render, and uses the updateScreenFn to trigger screen transitions.
So with this I have all I need to migrate the existing text adventure into Monogame.
Battle System
Now we can finally move onto the main event; the battle system! As mentioned earlier the aim is to produce a rudimentary version of the ATB system. It should support:
- A variable team of team members that can engage in the battle.
- A single enemy to fight against.
- Each combatant having an individual cooldown timer which has to finish before either the enemy attacks or the team member can choose an action.
- Each team member should have a choice of actions (for simplicity the choice will simply be attack or heal themselves).
- If a team member is killed, the cooldown timer should stop if it is running, and the team member should be rendered non interactive.
- If the enemy health is reduced to zero then the battle should be considered won and the game should continue.
- If all the team members have their health reduced to zero then the battle should be considered lost and the game over screen should appear.
If I aim to represent this battle system as a state machine, a few things stand out. For starters unlike the previous orchestrations I've outlined, this one is not a particularly linear workflow, so it will appear quite different to those previous examples.
I will also need to think about what shape the actions returned by the orchestrations will take. Sometimes an action will involve a persistant UI feature, for example a filling progress bar. Other times an action will occur instantly and not require any input from the player, for example when the enemy attacks a player. And I will need to consider how to track properties such as the combatants health over a series of events.
Now we will return to the actions themselves. the actions returned from the orchestration are a type represented by the following discriminated union:
type Action<'TActor> =
| TeamMemberActor of StoryShared.TeamMember * 'TActor
| EnemyInstant of BattleEvent
| EnemyActor of 'TActor
module Action =
let (|Actor|Instant|) = function
| TeamMemberActor (_, actor) -> Actor actor
| EnemyInstant battleEvent -> Instant battleEvent
| EnemyActor actor -> Actor actorI have used an active pattern to divide the action into either Actors or Instants. Instants will be picked up and applied instantly on the state machines. Actors are picked up by the battle screen to provide some UI that can be used to trigger the next step in the battle orchestration. Using an active pattern in this way means I dont need to impose a hierarchical structure on the actions, which just makes things simpler.
Actors implement the IActor interface:
type IActor =
abstract member OnUpdate: gameTime: GameTime -> unit
abstract member GetPanel: unit -> VerticalStackPanelSo I can retrieve a UI component for them, and I have a method I can forward to in the screens update method to update the component. Here is an example of some actor classes:
type ProgressBarActor (notifyComplete) =
let progressBar = HorizontalProgressBar(Width=100)
let mutable startTime: TimeSpan option = None
interface IActor with
member this.OnUpdate gameTime =
match startTime with
| None ->
do startTime <- Some gameTime.TotalGameTime
| Some startTime ->
let progress = (gameTime.TotalGameTime - startTime) / TimeSpan.FromSeconds(2.0)
if (progress < 1.0) then
do progressBar.Value <- (float32)progress * 100.0f
else
do notifyComplete gameTime.TotalGameTime
member this.GetPanel () =
let panel = VerticalStackPanel()
do panel.Widgets.Add(progressBar)
panel
type TeamMemberActor (onActionChosen) =
let mutable gameTime = TimeSpan.Zero
let panel = VerticalStackPanel()
let attackButton = Button(Content = Label(Text = "Attack"))
do attackButton.Click.Add(fun _ -> onActionChosen (Attack, gameTime))
let usePotionButton = Button(Content = Label(Text = "Use Potion"))
do usePotionButton.Click.Add(fun _ -> onActionChosen (UsePotion, gameTime))
do panel.Widgets.Add(attackButton)
do panel.Widgets.Add(usePotionButton)
interface IActor with
member this.OnUpdate gt =
do gameTime <- gt.TotalGameTime
member this.GetPanel () =
panel
type TeamMemberDeadActor () =
let panel = VerticalStackPanel()
let label = Label(Text = "Dead")
do panel.Widgets.Add(label)
interface IActor with
member this.OnUpdate gt = ()
member this.GetPanel () =
panelAs we can see, actors follow a similar pattern to screens, providing a mutable object that the monogame hooks can safely be forwarded to.
Much like the ScreenManager, I will add a class to wrap the battle orchestration, provide simple access to the actors and memoize them.
[<AllowNullLiteral>]
type BattleManager (battle: BattleOrchestration<IActor>, state, winBattle, loseBattle) =
let { CoordinationResult.Result = results } = battle None
let actions = List.collect (function | Break actions -> actions | _ -> []) results
let actors =
List.choose (function | Actor actor -> Some actor | _ -> None) actions
// make this an array as we will be iterating over it a lot
|> List.toArray
let teamMemberActors =
actions
|> List.choose (function | TeamMemberActor (tm, actor) -> Some (tm, actor) | _ -> None)
|> dict
|> System.Collections.Generic.Dictionary
let enemyActor =
actions
|> List.choose (function | EnemyActor actor -> Some actor | _ -> None)
// There should always be an enemy actor, so throw an exception if there isn't
|> List.last
member this.BattleState with get() =
state
member this.TeamMemberActors with get() =
teamMemberActors
member this.EnemyActor with get() =
enemyActor
member this.DoEvent (event: BattleEvent) =
let { Result = result; Next = next } = battle (Some event)
let state =
result
|> List.choose (function | Continue x -> Some x | _ -> None)
|> List.tryLast
match state, next with
| None, _ ->
failwith "Battle orchestration should always return state upon applying an event"
| Some Victory, _ ->
winBattle()
None
| Some Defeat, _ ->
loseBattle()
None
| _, None ->
failwith "Battle orchestration should be infinite sequence"
| Some state, Some next ->
Some (BattleManager(next, state, winBattle, loseBattle))
member this.OnUpdate gameTime =
do actors |> Array.iter (fun actor -> actor.OnUpdate(gameTime)) It also has a DoEvent method that applies an event to the battle orchestration and checks the resultant state to see if the battle has been won or lost, and calls the provided callback to trigger the appropriate screen transition if that is the case. For this to work the orchestration will need to return the current state of the battle on each event.
And i’ll add a class to manage the persistant UI for each individual combatant:
// Not existing would be an exceptional error, so using nulls rather than option types as it means less boilerplate
[<AllowNullLiteral>]
type CombatantPanelManager (name: string, actor: IActor) =
let memberPanel = VerticalStackPanel()
do memberPanel.Widgets.Add(Label(Text = name))
let healthLabel = Label(Text="Health")
do memberPanel.Widgets.Add(healthLabel)
let actorPanel = VerticalStackPanel()
do actorPanel.Widgets.Add(actor.GetPanel())
do memberPanel.Widgets.Add(actorPanel)
member this.Panel with get() = memberPanel
member this.UpdateHealth(health: float) =
do healthLabel.Text <- sprintf "Health: %f" health
member this.UpdateActorPanel(actor: IActor) =
do actorPanel.Widgets.Clear()
do actorPanel.Widgets.Add(actor.GetPanel())
static member GetTeamPanelManagers (battleState: BattleManager) =
battleState.TeamMemberActors
|> Seq.map (fun kvp -> kvp.Key, CombatantPanelManager(kvp.Key.ToString(), kvp.Value))
|> dict
|> System.Collections.Generic.Dictionary
static member GetEnemyPanelManager (battleState: BattleManager) =
CombatantPanelManager("Enemy", battleState.EnemyActor)Finally we have what we need to put into context the BattleScreen implementation.
type BattleScreen (desktop: Desktop, updateScreenFn: System.Action<ScreenJourneyEvent>, storyState: Story.State, gameState: GameState) =
let mutable battleState: BattleManager = null
let mutable team = System.Collections.Generic.Dictionary<StoryShared.TeamMember, CombatantPanelManager>()
let mutable enemy: CombatantPanelManager = null
let updateCombatants () =
let tmActors = battleState.TeamMemberActors
let tmState = battleState.BattleState.TeamMemberStates
for kvp in team do
let combatantManager = kvp.Value
let actor = tmActors[kvp.Key]
do combatantManager.UpdateActorPanel(actor)
let tmState = tmState.TryFind kvp.Key
do combatantManager.UpdateHealth tmState.Value
let enemyActor = battleState.EnemyActor
do enemy.UpdateActorPanel(enemyActor);
do enemy.UpdateHealth(battleState.BattleState.EnemyState)
let applyEventAndUpdate event =
let newBattleState = battleState.DoEvent(event)
if newBattleState.IsNone then
()
else
do battleState <- newBattleState.Value
do updateCombatants()
let progressBarActorFactory teamMember () =
let onProgressBarComplete gameTime =
let event = TeamMemberProgressBarComplete(teamMember, gameTime)
do applyEventAndUpdate event
new ProgressBarActor(onProgressBarComplete)
:> IActor
let enemyProgressBarActorFactory gameTime =
let enemyProgressBarComplete gameTime =
let event = EnemyProgressBarComplete(gameTime)
do applyEventAndUpdate event
new ProgressBarActor(enemyProgressBarComplete)
:> IActor
let teamMemberActorFactory teamMember () =
let tmActionChosen (action, gameTime) =
let event = TeamMemberChosenAction (teamMember, action, gameTime)
do applyEventAndUpdate event
new TeamMemberActor(tmActionChosen)
:> IActor
let teamMemberDeadActorFactory () =
new TeamMemberDeadActor()
:> IActor
let battleOrchestration =
fullBattleOrchestration
(BattleState.Init (storyState.CompanionsRecruited |> Set.toList))
progressBarActorFactory
enemyProgressBarActorFactory
teamMemberActorFactory
teamMemberDeadActorFactory
let winBattle () =
let newState = gameState.DoEvent (Story.StoryEvent.BattleOver)
match newState with
| Some newState -> updateScreenFn.Invoke(OpenGameScreen newState)
| None -> failwith "No new state from applying BattleOver event"
let loseBattle () =
do updateScreenFn.Invoke(OpenGameOverScreen gameState)
let setupScreen () =
let panel = Panel(VerticalAlignment = VerticalAlignment.Center, HorizontalAlignment = HorizontalAlignment.Center)
let stack = VerticalStackPanel()
let winButtonLabel = Label(HorizontalAlignment = HorizontalAlignment.Center, Text = "Win");
let winButton = Button(Content = winButtonLabel)
let teamStack = HorizontalStackPanel(VerticalAlignment = VerticalAlignment.Center)
for kvp in team do
do teamStack.Widgets.Add(kvp.Value.Panel)
let enemyStack = HorizontalStackPanel(VerticalAlignment = VerticalAlignment.Center)
do enemyStack.Widgets.Add(enemy.Panel)
do winButton.TouchDown.Add(fun _ -> winBattle ())
do stack.Widgets.Add(winButton);
do stack.Widgets.Add(enemyStack);
do stack.Widgets.Add(teamStack);
do panel.Widgets.Add(stack);
panel
interface IScreen with
member this.Initialise () =
let state = BattleState.Init (storyState.CompanionsRecruited |> Set.toList)
do battleState <- BattleManager(battleOrchestration, state, winBattle, loseBattle)
do team <- CombatantPanelManager.GetTeamPanelManagers battleState
do enemy <- CombatantPanelManager.GetEnemyPanelManager battleState
do desktop.Root <- setupScreen ()
do updateCombatants ()
member this.OnUpdate gameTime =
do battleState.OnUpdate(gameTime)
member this.OnRender () =
do desktop.Render()So as we can see the BattleScreen has factory methods for instantiating actors along with the necessary callbacks to integrate with the UI elements. However the business of actually instantiating the actors is taken care of by the battle orchestration that is passed the factory methods. In this way the battle orchestration can be kept pure and agnostic of UI details.
Now we can start looking in more detail at the battle orchestration itself. The events for the orchestration are as follows:
type BattleEvent =
| TeamMemberProgressBarComplete of StoryShared.TeamMember * TimeSpan
| TeamMemberChosenAction of StoryShared.TeamMember * TeamMemberAction * TimeSpan
| EnemyProgressBarComplete of TimeSpan
| EnemyAttack of StoryShared.TeamMember
and TeamMemberAction =
| Attack
| UsePotion
module BattleEvent =
let (|TeamMemberEvent|EnemyEvent|) = function
| TeamMemberProgressBarComplete (tm, _) -> TeamMemberEvent tm
| TeamMemberChosenAction (tm, _, _) -> TeamMemberEvent tm
| EnemyProgressBarComplete _ -> EnemyEvent
| EnemyAttack tm -> EnemyEventOnce again I am using an active pattern to categorise the events as it means that I don’t have to impose a hierarchical structure on the events themselves.
I will also need a type to represent the overall state of the battle, along with some utility functions to work with the state:
type BattleState =
{ TeamMemberStates: Map<StoryShared.TeamMember, TeamMemberState>
EnemyState: EnemyState }
static member Init teamMembers =
{ TeamMemberStates = teamMembers |> List.map (fun tm -> tm, 100) |> Map.ofList
EnemyState = 100 }
and TeamMemberState = int
and EnemyState = int
module BattleState =
let (|Victory|Defeat|Ongoing|) state =
if (state.TeamMemberStates |> Map.forall (fun _ hp -> hp <= 0)) then
Defeat
else if (state.EnemyState <= 0) then
Victory
else
Ongoing
let isTeamMemberAlive tm state =
state.TeamMemberStates |> Map.exists (fun tm2 hp -> tm = tm2 && hp > 0)
let deadTeamMembers state =
state.TeamMemberStates |> Map.filter (fun _ hp -> hp <= 0) |> Map.keys |> List.ofSeq
let private reduceTeamMemberHealth tm damage state =
let teamMemberStates =
state.TeamMemberStates
|> Map.map (fun tm' health ->
if tm' = tm
then Math.Max(health - damage, 0)
else health)
{ state with TeamMemberStates = teamMemberStates }
let private healTeamMember tm state =
let teamMemberStates =
state.TeamMemberStates
|> Map.map (fun tm' health ->
if tm' = tm
then Math.Min(health + 50, 100)
else health)
{ state with TeamMemberStates = teamMemberStates }
let updateState state = function
| TeamMemberChosenAction (tm, TeamMemberAction.Attack, _) ->
let enemyState = state.EnemyState - 10
{ state with EnemyState = enemyState }
| EnemyAttack tm ->
reduceTeamMemberHealth tm 10 state
| TeamMemberChosenAction (tm, TeamMemberAction.UsePotion, _) ->
healTeamMember tm state
| _ ->
stateIn order to actually calculate the state, I can use the same pattern I outlined in the previous article. I use the scan function, combined with an initial state and an update function to derive the state from the event sequence. The update function is the updateState function given above.
Before getting into the details of the orchestration itself, I will introduce some new utilities added to OrchestrationCE:
let rec combine coordination1 coordination2 event =
let { Result = r1; Next = n1 } = coordination1 event
let { Result = r2; Next = n2 } = coordination2 event
{ Result = r1 @ r2;
Next = match n1, n2 with
| None, None -> None
| Some n1, None -> Some n1
| None, Some n2 -> Some n2
| Some n1, Some n2 -> Some (combine n1 n2) }Combine just takes two coordinations and combines them into a single coordination (they must have the same generic signatures obviously).
let rec private applyBreaksRecursively' resultsSoFar chooser orchestration = function
| None -> orchestration None
| Some event ->
orchestration (Some event)
|> (function
| { Result = results; Next = None } ->
{ Result = results; Next = None }
| { Result = results; Next = Some next } ->
let event =
(next None).Result
|> List.collect (function | Break breaks -> breaks | _ -> [])
|> List.choose chooser
|> List.tryHead
match event with
| None ->
{ Result = resultsSoFar @ results; Next = Some (applyBreaksRecursively' [] chooser next) }
| Some event ->
applyBreaksRecursively' results chooser next (Some event))
let applyBreaksRecursively chooser = applyBreaksRecursively' [] chooserApplyBreaksRecursively takes an orchestration and creates a new orchestration that upon having an event applied, checks the actions that are available, and uses a supplied chooser function to get the instantly applicable events from these actions. If there are any instantly applicable events then it applies the first to the next step in the orchestration, and loops recursively. I will use this to implement the enemy attack action.
I also expanded the event and state code I started in the last article to add some utilities:
type EventAndState<'TState, 'TEvent> =
{ Event : 'TEvent
State : 'TState }
let stateAccumulator updateState eventAndState = function
| Some e -> { State = updateState eventAndState.State e; Event = Some e }
| None -> { State = eventAndState.State; Event = None }
let chooseOrchestrationEvents chooser = function
| { Event = Some e } ->
match chooser e with
| Some e -> Some (Some e)
| _ -> None
| { Event = None } ->
Some None
let chooseOrchestrationEventAndStates chooser = function
| { Event = Some e; State = state } ->
match chooser e with
| Some e -> Some { Event = Some e; State = state }
| _ -> None
| { Event = None; State = state } ->
Some { Event = None; State = state }
let raiseToOptionalEventAndState = function
| { Event = Some e; State = state } ->
Some { Event = e; State = state}
| { Event = None; State = state } ->
None
let chooseStateOnGetAction = function
| { Event = None; State = state } -> Some state
| _ -> NoneThese just help with the business of working with the state when working with orchestrations.
Now finally lets look at the code for the full orchestration:
let rec teamMemberOrchestration tm progressBarFactory teamMemberActorFactory = orchestration {
do! raiseToOrchestrationWithActions
[ TeamMemberActor(tm, progressBarFactory ()) ]
(event (function | TeamMemberProgressBarComplete _ -> Some () | _ -> None))
do! raiseToOrchestrationWithActions
[ TeamMemberActor(tm, teamMemberActorFactory ()) ]
(event (function | TeamMemberChosenAction _ -> Some () | _ -> None))
return! teamMemberOrchestration tm progressBarFactory teamMemberActorFactory
}
let rec enemyOrchestration progressBarFactory = orchestration {
let! (battleState: BattleState) =
raiseToOrchestrationWithActions
[ EnemyActor (progressBarFactory ()) ]
(event (function |{ Event = EnemyProgressBarComplete _; State = state } -> Some state | _ -> None))
// Simple enemy ai: attack the weakest team member
let weakestTeamMember =
battleState.TeamMemberStates
|> Map.toSeq
|> Seq.filter (fun (_, hp) -> hp > 0)
|> Seq.minBy (fun (_, hp) -> hp)
|> fst
do! raiseToOrchestrationWithActions
[ EnemyInstant (EnemyAttack (weakestTeamMember)) ]
(event (function | { Event = EnemyAttack _ } -> Some () | _ -> None))
return! enemyOrchestration progressBarFactory
}
let fullBattleOrchestration teamMembers tmProgressBarFactory enemyProgressBarFactory teamMemberActorFactory teamMemberDeadActorFactory =
event Some
|> scan (stateAccumulator BattleState.updateState) ({ Event = None; State = BattleState.Init teamMembers })
|> skip 1
|> compose
(event (chooseOrchestrationEventAndStates (function | BattleEvent.TeamMemberEvent (tm) as e -> Some (tm, e) | _ -> None))
// Combines the orchestrations for each alive team member
|> compose (
teamMembers
|> List.map (
fun teamMember ->
event (chooseOrchestrationEventAndStates (fun (tm, e) -> if tm = teamMember then Some e else None))
// Only considering alive team members here
|> filter (fun { State = state: BattleState } -> BattleState.isTeamMemberAlive teamMember state)
|> choose (chooseOrchestrationEvents (Some))
|> compose (teamMemberOrchestration teamMember (tmProgressBarFactory teamMember) (teamMemberActorFactory teamMember)))
|> List.fold combine empty)
// Any event can lead to a team member death, so handle that possibility here
|> combine
(event chooseStateOnGetNextStep
|> map (fun (state: BattleState) ->
state
|> BattleState.deadTeamMembers
|> List.map (fun tm -> (tm, (teamMemberDeadActorFactory ())))
|> List.map TeamMemberActor
|> Break))
// Adds the enemy orchestration
|> combine
(event (chooseOrchestrationEventAndStates (function | BattleEvent.EnemyEvent as e -> Some e | _ -> None))
|> map raiseToOptionalEventAndState
|> compose (enemyOrchestration enemyProgressBarFactory))
// Return the state on every event
|> combine
(event (function | { State = state; Event = Some _ } -> Some state | _ -> None)
|> map (CircuitBreaker.retn)))
// Recursively apply enemy instant attacks within the state machine immediately after they are generated
|> applyBreaksRecursively (function | Action.Instant event -> Some event | _ -> None)
It’s a bit chewy, so lets go through it. In the first few lines it basically sets up a coordination that takes a battle event, and uses scan to track the state of the battle as optional events are passed in. This optional event and state are then used as the events for a coordination that is build using the combine function I outlined earlier. Each coordination that is combined starts by using an event function to reshape the the event and state, and then pushes it into a given orchestration or coordination. In this way I combine the various orchestrations for each team member as well as the enemy. I ensure that I return the current state upon each event being applied, and finally I use applyBreaksRecursively to instantly run enemy attacks.
With that the initial battle system is complete! I hope you enjoyed reading as much as I enjoyed writing!