diff --git a/src/Duets.Cli/Components/Commands/Clock.Command.fs b/src/Duets.Cli/Components/Commands/Clock.Command.fs index a6a635e7..fc0849ef 100644 --- a/src/Duets.Cli/Components/Commands/Clock.Command.fs +++ b/src/Duets.Cli/Components/Commands/Clock.Command.fs @@ -1,9 +1,12 @@ namespace Duets.Cli.Components.Commands +open Duets.Agents open Duets.Cli.Components open Duets.Cli.SceneIndex open Duets.Cli.Text +open Duets.Common open Duets.Entities +open Duets.Simulation [] module ClockCommand = @@ -19,6 +22,9 @@ module ClockCommand = "Shows the current day moment and the number of day moments until the end of the day" Handler = (fun _ -> + let turnInfo = + Queries.Calendar.currentTurnInformation (State.get ()) + dayMomentsWithEvents |> List.indexed |> List.fold @@ -58,4 +64,11 @@ module ClockCommand = |> Styles.highlight |> showMessage + let formatDayMoment = + Generic.dayMomentName >> String.lowercase >> Styles.time + + $"Spent {turnInfo.TimeSpent} minutes on {turnInfo.CurrentDayMoment |> formatDayMoment}. {turnInfo.TimeLeft} minutes until {turnInfo.NextDayMoment |> formatDayMoment}" + |> Styles.faded + |> showMessage + Scene.World) } diff --git a/src/Duets.Cli/Components/Commands/Help.Command.fs b/src/Duets.Cli/Components/Commands/Help.Command.fs index 1831569a..1f5df8dc 100644 --- a/src/Duets.Cli/Components/Commands/Help.Command.fs +++ b/src/Duets.Cli/Components/Commands/Help.Command.fs @@ -9,7 +9,7 @@ open Duets.Entities module HelpCommand = /// Creates a command that shows the name and description of all given /// commands as a list. - let create (commands: (int * Command) list) = + let create (commands: Command list) = { Name = "help" Description = Command.helpDescription Handler = @@ -17,17 +17,12 @@ module HelpCommand = showMessage Command.helpDescription let columns = - [ Styles.header "Command" - Styles.header "Description" - Styles.header Emoji.clock ] + [ Styles.header "Command"; Styles.header "Description" ] let rows = commands - |> List.map (fun (timeConsumption, command) -> - [ Styles.highlight command.Name - command.Description - if timeConsumption > 0 then - $"{timeConsumption}" ]) + |> List.map (fun command -> + [ Styles.highlight command.Name; command.Description ]) showTable columns rows diff --git a/src/Duets.Cli/Components/Commands/MiniGame/Leave.Command.fs b/src/Duets.Cli/Components/Commands/MiniGame/Leave.Command.fs index e4d0c61e..4dea7d4c 100644 --- a/src/Duets.Cli/Components/Commands/MiniGame/Leave.Command.fs +++ b/src/Duets.Cli/Components/Commands/MiniGame/Leave.Command.fs @@ -16,7 +16,7 @@ module LeaveCommand = $"Allows you to leave the {Generic.miniGameName miniGameId} game" Handler = (fun _ -> - let result = Blackjack.leave (State.get ()) miniGameState + let result = Blackjack.leave miniGameState match result with | Ok effect -> effect |> Effect.applyMultiple diff --git a/src/Duets.Cli/Components/Effect.fs b/src/Duets.Cli/Components/Effect.fs index d65d5de7..8940a7bb 100644 --- a/src/Duets.Cli/Components/Effect.fs +++ b/src/Duets.Cli/Components/Effect.fs @@ -62,7 +62,7 @@ let private displayEffect effect = let place = job.Location ||> Queries.World.placeInCityById Career.careerPromoted job place.Name salary |> showMessage - | CareerShiftPerformed(_, payment) -> + | CareerShiftPerformed(_, _, payment) -> Career.workShiftFinished payment |> showMessage | CharacterAttributeChanged(_, attr, Diff(previous, current)) -> match attr with @@ -199,7 +199,7 @@ let private displayEffect effect = "Choose where you want to go next" |> showMessage showMapUntilChoice () |> applyMultiple - | PlayResult result -> + | GamePlayed result -> lineBreak () let gameResultMessage simpleResult = diff --git a/src/Duets.Cli/Scenes/World.fs b/src/Duets.Cli/Scenes/World.fs index c80e00ea..85f18a69 100644 --- a/src/Duets.Cli/Scenes/World.fs +++ b/src/Duets.Cli/Scenes/World.fs @@ -190,8 +190,7 @@ let private commandsFromInteractions interactions = match interactionWithMetadata.State with | InteractionState.Enabled -> command | InteractionState.Disabled disabledReason -> - Command.disable disabledReason command - |> Tuple.two interactionWithMetadata.TimeAdvance) + Command.disable disabledReason command) let private filterAttributesForInfoBar = List.choose (fun (attr, amount) -> @@ -275,11 +274,10 @@ let worldScene mode = relationshipLevel | _ -> Command.commonPrompt today currentDayMoment characterAttributes - let commandsWithMetadata = + let commands = commandsFromInteractions interactionsWithState - @ [ (0, ExitCommand.get); (0, MeCommand.get) ] + @ [ ExitCommand.get; MeCommand.get ] - commandsWithMetadata - |> List.map snd - |> (@) [ HelpCommand.create commandsWithMetadata ] + commands + |> (@) [ HelpCommand.create commands ] |> showCommandPrompt promptText diff --git a/src/Duets.Common/Func.fs b/src/Duets.Common/Func.fs index 21fd6436..5e42a8ec 100644 --- a/src/Duets.Common/Func.fs +++ b/src/Duets.Common/Func.fs @@ -2,3 +2,6 @@ module Duets.Common.Func /// Transforms an F# function into a System.Func. let toFunc<'a, 'b> f = System.Func<'a, 'b>(f) + +/// Wraps a value in a function that ignores its input and returns the value. +let toConst<'a> (value: 'a) _ = value diff --git a/src/Duets.Entities/Calendar.fs b/src/Duets.Entities/Calendar.fs index ab31b3ae..7f335421 100644 --- a/src/Duets.Entities/Calendar.fs +++ b/src/Duets.Entities/Calendar.fs @@ -1,7 +1,8 @@ module rec Duets.Entities.Calendar -open Duets.Common +open FSharp.Data.UnitSystems.SI.UnitNames open Fugit.Shorthand +open Duets.Common open System open System.Globalization @@ -27,8 +28,13 @@ let everyDay = DayOfWeek.Sunday ] module DayMoments = + /// Contains all the possible day moments in a week. let oneWeek = Calendar.allDayMoments |> List.length |> (*) 7 + /// Transforms the given number of day moments into minutes. + let toMinutes dayMoments = + dayMoments / 1 * 180 + [] module Ops = /// Adds the given number of days to the date. @@ -214,5 +220,11 @@ module Parse = | "Midnight" -> Midnight | _ -> EarlyMorning + +[] +module Seconds = + /// Transforms the given number of seconds into minutes. + let toMinutes seconds = (seconds / 60) * 1 + /// Returns the date in which the game starts. let gameBeginning = Date.Now |> Transform.changeDayMoment EarlyMorning diff --git a/src/Duets.Entities/Lenses.fs b/src/Duets.Entities/Lenses.fs index c4e8f12c..68724532 100644 --- a/src/Duets.Entities/Lenses.fs +++ b/src/Duets.Entities/Lenses.fs @@ -90,6 +90,10 @@ module State = let today_ = (fun (s: State) -> s.Today), (fun v (s: State) -> { s with Today = v }) + let turnMinutes_ = + (fun (s: State) -> s.TurnMinutes), + (fun v (s: State) -> { s with TurnMinutes = v }) + let worldItems_ = (fun (s: State) -> s.WorldItems), (fun v (s: State) -> { s with WorldItems = v }) diff --git a/src/Duets.Entities/State.fs b/src/Duets.Entities/State.fs index a6470cd4..076cfe16 100644 --- a/src/Duets.Entities/State.fs +++ b/src/Duets.Entities/State.fs @@ -32,4 +32,5 @@ let empty = SocialNetworkCurrentAccountStatus.NoAccountCreated Accounts = Map.empty } } Today = Calendar.gameBeginning + TurnMinutes = 0 WorldItems = Map.empty } diff --git a/src/Duets.Entities/Types/Effect.Types.fs b/src/Duets.Entities/Types/Effect.Types.fs index af63f675..e5b54d07 100644 --- a/src/Duets.Entities/Types/Effect.Types.fs +++ b/src/Duets.Entities/Types/Effect.Types.fs @@ -11,14 +11,20 @@ module EffectTypes = | AlbumReleased of Band * ReleasedAlbum | AlbumReleasedUpdate of Band * ReleasedAlbum | AlbumReviewsReceived of Band * ReleasedAlbum + | AlbumSongAdded of Band * UnreleasedAlbum * Recorded | AlbumUpdated of Band * UnreleasedAlbum + | Ate of item: Item * food: EdibleItem | BalanceUpdated of BankAccountHolder * Diff | BandFansChanged of Band * Diff | BandSwitchedGenre of Band * Diff + | BookRead of Item * Book | CareerAccept of CharacterId * Job | CareerLeave of CharacterId * Job | CareerPromoted of Job * salary: Amount - | CareerShiftPerformed of Job * payment: Amount + | CareerShiftPerformed of + Job * + shiftDuration: int * + payment: Amount | CharacterAttributeChanged of character: CharacterId * attribute: CharacterAttribute * @@ -32,9 +38,14 @@ module EffectTypes = | ConcertFinished of band: Band * concert: PastConcert * income: Amount | ConcertUpdated of Band * ScheduledConcert | ConcertCancelled of Band * PastConcert + | ConcertSoundcheckPerformed + | Drank of item: Item * drink: DrinkableItem + | Exercised of Item | FlightBooked of Flight | FlightUpdated of Flight + | FlightLanded of Flight | GameCreated of State + | GamePlayed of PlayResult | GenreMarketsUpdated of GenreMarketByGenre | ItemAddedToCharacterInventory of Item | ItemChangedInCharacterInventory of Diff @@ -45,8 +56,10 @@ module EffectTypes = | ItemRemovedFromWorld of RoomCoordinates * Item | MerchPriceSet of band: Band * merchItem: Item * price: Amount | MerchSold of band: Band * (Item * int) list * income: Amount + | MerchStandSetup | MemberHired of Band * Character * CurrentMember * SkillWithLevel list | MemberFired of Band * CurrentMember * PastMember + | MiniGamePlayed of MiniGameId | MoneyEarned of BankAccountHolder * BankTransaction | MoneyTransferred of BankAccountHolder * BankTransaction | NotificationScheduled of Date * DayMoment * Notification @@ -61,6 +74,7 @@ module EffectTypes = | RentalUpdated of Rental | SituationChanged of Situation | SkillImproved of Character * Diff + | SocialActionPerformed of SocializingState * SocialActionKind | SocialNetworkAccountCreated of SocialNetworkKey * SocialNetworkAccount | SocialNetworkAccountFollowersChanged of SocialNetworkKey * @@ -80,8 +94,9 @@ module EffectTypes = | SongDiscarded of Band * Unfinished | SongPracticed of Band * Finished | PlaceClosed of Place - | PlayResult of PlayResult | TimeAdvanced of Date + | TurnTimeUpdated of int + | WatchedTv of Item /// Moves the player to a new room inside the current place. | WorldEnterRoom of Diff /// Moves the player to a different place in the current city or a diff --git a/src/Duets.Entities/Types/Interaction.Types.fs b/src/Duets.Entities/Types/Interaction.Types.fs index 453be482..94008019 100644 --- a/src/Duets.Entities/Types/Interaction.Types.fs +++ b/src/Duets.Entities/Types/Interaction.Types.fs @@ -253,8 +253,7 @@ module InteractionTypes = /// of time that it'll take to perform it. type InteractionWithMetadata = { Interaction: Interaction - State: InteractionState - TimeAdvance: int } + State: InteractionState } /// Defines a simple win/lose result for a non-interactive game. [] diff --git a/src/Duets.Entities/Types/State.Types.fs b/src/Duets.Entities/Types/State.Types.fs index 1fb2dfef..76328360 100644 --- a/src/Duets.Entities/Types/State.Types.fs +++ b/src/Duets.Entities/Types/State.Types.fs @@ -27,5 +27,7 @@ module StateTypes = Rentals: CharacterRentals Situation: Situation SocialNetworks: SocialNetworks + // TODO: Merge today and turn minutes into one property. Today: Date + TurnMinutes: int WorldItems: WorldItems } diff --git a/src/Duets.Simulation/Careers/Work.fs b/src/Duets.Simulation/Careers/Work.fs index c0500f9d..dea099f5 100644 --- a/src/Duets.Simulation/Careers/Work.fs +++ b/src/Duets.Simulation/Careers/Work.fs @@ -4,7 +4,6 @@ open Duets.Entities open Duets.Simulation open Duets.Simulation.Bank.Operations open Duets.Simulation.Character -open Duets.Simulation.Time let private workAttributeChange state (job: Job) = let character = Queries.Characters.playableCharacter state @@ -44,7 +43,6 @@ let workShift state job = let characterAccount = Queries.Bank.playableCharacterAccount state let shiftDayMoments = timeAdvancement state job - let timeEffects = AdvanceTime.advanceDayMoment' state shiftDayMoments let shiftSalary = job.CurrentStage.BaseSalaryPerDayMoment * decimal shiftDayMoments @@ -53,7 +51,6 @@ let workShift state job = let attributeEffects = workAttributeChange state job - [ yield CareerShiftPerformed(job, shiftSalary) - yield! timeEffects + [ yield CareerShiftPerformed(job, shiftDayMoments, shiftSalary) yield shiftPay yield! attributeEffects ] diff --git a/src/Duets.Simulation/Concerts/Live/Live.Actions.fs b/src/Duets.Simulation/Concerts/Live/Live.Actions.fs index ff77154d..104bf65b 100644 --- a/src/Duets.Simulation/Concerts/Live/Live.Actions.fs +++ b/src/Duets.Simulation/Concerts/Live/Live.Actions.fs @@ -18,7 +18,9 @@ let soundcheck state checklist = Config.MusicSimulation.Merch.soundcheckTime |> advanceDayMoment' state - [ Situations.preparingConcert' updatedChecklist; yield! timeEffects ] + [ ConcertSoundcheckPerformed + Situations.preparingConcert' updatedChecklist + yield! timeEffects ] /// Sets up the merch stand, which improves the ticket sales of the concert. @@ -35,7 +37,9 @@ let setupMerchStand state checklist = Config.MusicSimulation.Merch.standSetupTime |> advanceDayMoment' state - [ Situations.preparingConcert' updatedChecklist; yield! timeEffects ] + [ MerchStandSetup + Situations.preparingConcert' updatedChecklist + yield! timeEffects ] /// Starts the given concert if the band is ready to play. let startConcert state concert = diff --git a/src/Duets.Simulation/Config.fs b/src/Duets.Simulation/Config.fs index 8d016d4b..edb7f9e6 100644 --- a/src/Duets.Simulation/Config.fs +++ b/src/Duets.Simulation/Config.fs @@ -188,6 +188,11 @@ module Revenue = /// Indicates how many dd a band makes per stream. let revenuePerStream = 0.0055 +module Time = + /// Number of minutes that a day moment has, which is effectively the + /// number of minutes we allow the player to perform per turn. + let minutesPerDayMoment = 180 + module Travel = /// Price per kilometers for buying plane tickets. let pricePerKm = 0.067m diff --git a/src/Duets.Simulation/Duets.Simulation.fsproj b/src/Duets.Simulation/Duets.Simulation.fsproj index d64747dc..4e9b5a68 100644 --- a/src/Duets.Simulation/Duets.Simulation.fsproj +++ b/src/Duets.Simulation/Duets.Simulation.fsproj @@ -1,185 +1,184 @@ - - net8.0 - true - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + net8.0 + true + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/src/Duets.Simulation/Events/Career.Events.fs b/src/Duets.Simulation/Events/Career.Events.fs index 3969a6d2..9eeef55d 100644 --- a/src/Duets.Simulation/Events/Career.Events.fs +++ b/src/Duets.Simulation/Events/Career.Events.fs @@ -10,7 +10,7 @@ open Duets.Simulation.Skills.Improve /// for the next level. let internal run effect = match effect with - | CareerShiftPerformed(job, _) -> + | CareerShiftPerformed(job, _, _) -> [ Career.improveCharacterSkillsAfterShift job Careers.Promotion.promoteIfNeeded job ] |> ContinueChain diff --git a/src/Duets.Simulation/Events/NonInteractiveGame.Events.fs b/src/Duets.Simulation/Events/NonInteractiveGame.Events.fs index dcf238aa..85d382ee 100644 --- a/src/Duets.Simulation/Events/NonInteractiveGame.Events.fs +++ b/src/Duets.Simulation/Events/NonInteractiveGame.Events.fs @@ -9,8 +9,8 @@ open Duets.Simulation /// character and the rest of the band. let internal run effect = match effect with - | PlayResult(PlayResult.Darts result) - | PlayResult(PlayResult.Pool result) -> + | GamePlayed(PlayResult.Darts result) + | GamePlayed(PlayResult.Pool result) -> match result with | SimpleResult.Win -> [ Character.Attribute.addToPlayable diff --git a/src/Duets.Simulation/Events/Time.Events.fs b/src/Duets.Simulation/Events/Time.Events.fs index 78407318..16a2d91e 100644 --- a/src/Duets.Simulation/Events/Time.Events.fs +++ b/src/Duets.Simulation/Events/Time.Events.fs @@ -41,8 +41,5 @@ let internal run effect = |> ContinueChain |> Some | Wait times -> - [ fun state -> AdvanceTime.advanceDayMoment' state times - AttributeChange.applyAfterWait times ] - |> ContinueChain - |> Some + [ AttributeChange.applyAfterWait times ] |> ContinueChain |> Some | _ -> None diff --git a/src/Duets.Simulation/Flights/Airport.fs b/src/Duets.Simulation/Flights/Airport.fs index 3e287137..4c5a15d1 100644 --- a/src/Duets.Simulation/Flights/Airport.fs +++ b/src/Duets.Simulation/Flights/Airport.fs @@ -41,17 +41,11 @@ let boardPlane flight = /// Passes as many day moments needed for the flight to complete and leaves /// the character in the destination's airport. let leavePlane state flight = - let dayMomentsNeeded = - AirportInteraction.WaitUntilLanding flight - |> Interaction.Airport - |> Queries.InteractionTime.timeRequired - let destinationAirport = Queries.World.placeIdsByTypeInCity flight.Destination PlaceTypeIndex.Airport |> List.head (* All cities must have an airport. *) - [ yield! AdvanceTime.advanceDayMoment' state dayMomentsNeeded - Navigation.travelTo flight.Destination destinationAirport state + [ Navigation.travelTo flight.Destination destinationAirport state Situations.freeRoam ] diff --git a/src/Duets.Simulation/Interactions/Items/Actions/Exercise.Action.fs b/src/Duets.Simulation/Interactions/Items/Actions/Exercise.Action.fs new file mode 100644 index 00000000..16003470 --- /dev/null +++ b/src/Duets.Simulation/Interactions/Items/Actions/Exercise.Action.fs @@ -0,0 +1,25 @@ +module rec Duets.Simulation.Interactions.Actions.Exercise + +open Duets.Entities +open Duets.Simulation + +/// Applies the effects of exercising with an item. +let exercise item character state = + [ yield Exercised item + yield! + Character.Attribute.add + character + CharacterAttribute.Energy + Config.LifeSimulation.Energy.exerciseIncrease + yield! + Character.Attribute.add + character + CharacterAttribute.Health + Config.LifeSimulation.Health.exerciseIncrease + yield! + Skills.Improve.Common.applySkillModificationChance + state + {| Chance = 30 + CharacterId = character.Id + ImprovementAmount = 1 + Skills = [ SkillId.Fitness ] |} ] diff --git a/src/Duets.Simulation/Interactions/Items/Drink.Interactions.fs b/src/Duets.Simulation/Interactions/Items/Drink.Interactions.fs index bce2b269..1b2f554c 100644 --- a/src/Duets.Simulation/Interactions/Items/Drink.Interactions.fs +++ b/src/Duets.Simulation/Interactions/Items/Drink.Interactions.fs @@ -10,14 +10,15 @@ open Duets.Simulation /// - If the drink is a beer or some other alcoholic beverage, the fun begins! /// This calculates how the drink impacts the player depending on its quantity /// and alcoholic content, increasing the character's drunkenness. -let rec drink state item (amount: int) drinkType = +let rec drink state item drink = let character = Queries.Characters.playableCharacter state - match drinkType with - | Beer(alcoholContent) -> drinkAlcohol character amount alcoholContent + match drink.DrinkType with + | Beer(alcoholContent) -> drinkAlcohol character drink.Amount alcoholContent | Coffee amount -> drinkCoffee character amount | Soda -> [] @ Items.remove state item + @ [ Drank(item, drink) ] and private drinkAlcohol character amount alcoholContent = let amountOfAlcohol = (float amount * alcoholContent) / 100.0 diff --git a/src/Duets.Simulation/Interactions/Items/Food.Interactions.fs b/src/Duets.Simulation/Interactions/Items/Food.Interactions.fs index 1eee6ee4..0b67c341 100644 --- a/src/Duets.Simulation/Interactions/Items/Food.Interactions.fs +++ b/src/Duets.Simulation/Interactions/Items/Food.Interactions.fs @@ -7,14 +7,15 @@ open Duets.Simulation /// Eats the given item. Returns different effects depending on the type of food: /// - For junk food, it slightly decreases health depending on the amount consumed /// and slightly increases happiness. -let eat state item (amount: int) foodType = +let eat state item food = let character = Queries.Characters.playableCharacter state - match foodType with - | Unhealthy -> eatUnhealthyFood character amount + match food.FoodType with + | Unhealthy -> eatUnhealthyFood character food.Amount | Regular - | Healthy -> eatRegularFood character amount - @ (Items.remove state item) + | Healthy -> eatRegularFood character food.Amount + @ Items.remove state item + @ [ Ate(item, food) ] let private calculateHungerIncrease amount = float amount * 0.15 |> Math.roundToNearest diff --git a/src/Duets.Simulation/Interactions/Items/Item.Interactions.fs b/src/Duets.Simulation/Interactions/Items/Item.Interactions.fs index 2716ffe4..cf5ad308 100644 --- a/src/Duets.Simulation/Interactions/Items/Item.Interactions.fs +++ b/src/Duets.Simulation/Interactions/Items/Item.Interactions.fs @@ -91,49 +91,25 @@ let private nonInteractiveGameResult () = let perform state (item: Item) action = let character = Queries.Characters.playableCharacter state - let timeEffects = - action - |> Interaction.Item - |> Queries.InteractionTime.timeRequired - |> Time.AdvanceTime.advanceDayMoment' state - match action, item with - | Drinking drink -> - Drink.drink state item drink.Amount drink.DrinkType |> Ok - | Eating food -> Food.eat state item food.Amount food.FoodType |> Ok - | ExercisingOnGym -> - [ yield! - Character.Attribute.add - character - CharacterAttribute.Energy - Config.LifeSimulation.Energy.exerciseIncrease - yield! - Character.Attribute.add - character - CharacterAttribute.Health - Config.LifeSimulation.Health.exerciseIncrease - yield! - Skills.Improve.Common.applySkillModificationChance - state - {| Chance = 30 - CharacterId = character.Id - ImprovementAmount = 1 - Skills = [ SkillId.Fitness ] |} ] - |> Ok + | Drinking drink -> Drink.drink state item drink |> Ok + | Eating food -> Food.eat state item food |> Ok + | ExercisingOnGym -> Actions.Exercise.exercise item character state |> Ok | PlayingDarts -> - [ nonInteractiveGameResult () |> PlayResult.Darts |> PlayResult ] |> Ok + [ nonInteractiveGameResult () |> PlayResult.Darts |> GamePlayed ] |> Ok | PlayingBilliard -> - [ nonInteractiveGameResult () |> PlayResult.Pool |> PlayResult ] |> Ok + [ nonInteractiveGameResult () |> PlayResult.Pool |> GamePlayed ] |> Ok | PlayingVideoGames -> [ yield! Character.Attribute.add character CharacterAttribute.Mood Config.LifeSimulation.Mood.playingVideoGamesIncrease - PlayResult(PlayResult.VideoGame) ] + GamePlayed(PlayResult.VideoGame) ] |> Ok | ReadingBooks book -> - [ yield! Actions.Read.read item book state + [ yield BookRead(item, book) + yield! Actions.Read.read item book state yield! Character.Attribute.add character @@ -141,10 +117,11 @@ let perform state (item: Item) action = Config.LifeSimulation.Mood.readingBookIncrease ] |> Ok | WatchingTV -> - Character.Attribute.add - character - CharacterAttribute.Mood - Config.LifeSimulation.Mood.watchingTvIncrease + [ yield WatchedTv item + yield! + Character.Attribute.add + character + CharacterAttribute.Mood + Config.LifeSimulation.Mood.watchingTvIncrease ] |> Ok | _ -> Error ActionNotPossible - |> Result.map (fun effects -> timeEffects @ effects) diff --git a/src/Duets.Simulation/MiniGames/Blackjack.fs b/src/Duets.Simulation/MiniGames/Blackjack.fs index 80950ac8..a5ec40db 100644 --- a/src/Duets.Simulation/MiniGames/Blackjack.fs +++ b/src/Duets.Simulation/MiniGames/Blackjack.fs @@ -196,14 +196,8 @@ let stand state game = /// Allows the player to leave the current mini-game as long as they're still /// in the betting phase. -let leave state game = - let timeEffects = - MiniGameInGameInteraction.Leave(MiniGameId.Blackjack, game) - |> MiniGameInteraction.InGame - |> Interaction.MiniGame - |> Queries.InteractionTime.timeRequired - |> AdvanceTime.advanceDayMoment' state - +let leave game = match game with - | Betting -> Situations.freeRoam :: timeEffects |> Ok + | Betting -> + Situations.freeRoam :: [ MiniGamePlayed MiniGameId.Blackjack ] |> Ok | _ -> Error NotAllowed diff --git a/src/Duets.Simulation/Queries/Calendar.fs b/src/Duets.Simulation/Queries/Calendar.fs index 77798ea7..5fd624ae 100644 --- a/src/Duets.Simulation/Queries/Calendar.fs +++ b/src/Duets.Simulation/Queries/Calendar.fs @@ -3,6 +3,7 @@ namespace Duets.Simulation.Queries module Calendar = open Aether open Duets.Entities + open Duets.Simulation /// Returns the current date in game. let today state = state |> Optic.get Lenses.State.today_ @@ -17,3 +18,20 @@ module Calendar = Seq.initInfinite (fun index -> currentDate |> Calendar.Query.nextN (index + 1)) + + /// Returns information about the current turn, including the current day + /// moment, the time spent in the current day moment, the duration of the + /// day moment and the time left in the current day moment. + let currentTurnInformation state = + let currentDayMoment = today state |> Calendar.Query.dayMomentOf + let nextDayMoment = currentDayMoment |> Calendar.Query.nextDayMoment + + let currentTurnTime = state |> Optic.get Lenses.State.turnMinutes_ + + let dayMomentDuration = Config.Time.minutesPerDayMoment + + {| CurrentDayMoment = currentDayMoment + NextDayMoment = nextDayMoment + TimeSpent = currentTurnTime + DayMomentDuration = dayMomentDuration + TimeLeft = dayMomentDuration - currentTurnTime |} diff --git a/src/Duets.Simulation/Queries/Interactions/InteractionTime.fs b/src/Duets.Simulation/Queries/Interactions/InteractionTime.fs deleted file mode 100644 index 7d521cf4..00000000 --- a/src/Duets.Simulation/Queries/Interactions/InteractionTime.fs +++ /dev/null @@ -1,50 +0,0 @@ -namespace Duets.Simulation.Queries - -open Duets.Entities - -module InteractionTime = - /// Returns how many day moments a certain interaction should advance. - let timeRequired interaction = - match interaction with - | Interaction.Airport(AirportInteraction.WaitUntilLanding flight) -> - Flights.flightDayMoments flight - | Interaction.Career(CareerInteraction.Work job) -> - Career.jobDuration job - | Interaction.Concert(ConcertInteraction.SetupMerchStand _) -> - 1 - | Interaction.Concert(ConcertInteraction.FinishConcert _) -> - 2 - | Interaction.Item(itemInteraction) -> - match itemInteraction with - | ItemInteraction.Exercise - | ItemInteraction.Play - | ItemInteraction.Read - | ItemInteraction.Watch -> 1 - | ItemInteraction.Cook _ - | ItemInteraction.Drink - | ItemInteraction.Eat - | ItemInteraction.Open - | ItemInteraction.Put - | ItemInteraction.Sleep (* Sleeping asks how long to sleep. *) -> - 0 - | Interaction.FreeRoam FreeRoamInteraction.Wait -> 1 - | Interaction.MiniGame(MiniGameInteraction.StartGame _) - | Interaction.MiniGame(MiniGameInteraction.InGame(MiniGameInGameInteraction.Leave _)) -> - 1 - | Interaction.Rehearsal rehearsalInteraction -> - match rehearsalInteraction with - | RehearsalInteraction.ComposeNewSong - | RehearsalInteraction.ImproveSong _ - | RehearsalInteraction.PracticeSong _ -> 1 - | _ -> 0 - | Interaction.Studio studioInteraction -> - match studioInteraction with - | StudioInteraction.CreateAlbum _ - | StudioInteraction.AddSongToAlbum _ -> 2 - | _ -> 0 - | Interaction.Social socialInteraction -> - match socialInteraction with - | SocialInteraction.StartConversation _ - | SocialInteraction.StopConversation -> 1 - | _ -> 0 - | _ -> 0 diff --git a/src/Duets.Simulation/Queries/Interactions/Interactions.fs b/src/Duets.Simulation/Queries/Interactions/Interactions.fs index e7abd8d2..6b4d5eb3 100644 --- a/src/Duets.Simulation/Queries/Interactions/Interactions.fs +++ b/src/Duets.Simulation/Queries/Interactions/Interactions.fs @@ -98,7 +98,6 @@ module Interactions = |> InteractionCommon.filterOutSituationalInteractions state |> List.map (fun interaction -> { Interaction = interaction - State = InteractionState.Enabled - TimeAdvance = InteractionTime.timeRequired interaction }) + State = InteractionState.Enabled }) |> HealthRequirements.check state |> EnergyRequirements.check state diff --git a/src/Duets.Simulation/Setup/StartGame.fs b/src/Duets.Simulation/Setup/StartGame.fs index f10a8ece..7983cfc5 100644 --- a/src/Duets.Simulation/Setup/StartGame.fs +++ b/src/Duets.Simulation/Setup/StartGame.fs @@ -92,6 +92,7 @@ let startGame Situation = FreeRoam SocialNetworks = SocialNetwork.empty Today = Calendar.gameBeginning + TurnMinutes = 0 WorldItems = allInitialWorldItems } |> Bands.Generation.addInitialBandsToState |> GameCreated diff --git a/src/Duets.Simulation/Simulation.fs b/src/Duets.Simulation/Simulation.fs index d8401f34..aef9803b 100644 --- a/src/Duets.Simulation/Simulation.fs +++ b/src/Duets.Simulation/Simulation.fs @@ -1,8 +1,12 @@ [] module Duets.Simulation.Simulation +open Aether +open Duets.Common open Duets.Entities open Duets.Simulation.Events +open Duets.Simulation.Time.AdvanceTime +open Duets.Simulation.Time.InteractionMinutes type private TickState = { AppliedEffects: Effect list @@ -27,7 +31,10 @@ and private tickEffect tickState nextEffectFns effects = EffectModifiers.EffectModifiers.modify tickState.State effect let updatedState = State.Root.applyEffect tickState.State effect - let associatedEffectFns = Events.associatedEffects effect + + let associatedEffectFns = + [ yield! Events.associatedEffects effect + yield! applyTime effect updatedState ] (* Tick all the associated effects first, and pass the rest of the effects that come after the current one that was applied plus all @@ -56,11 +63,41 @@ and private tickAssociatedEffects tickState associatedEffects nextEffectFns = |> tickAssociatedEffects tickState restOfAssociatedEffects | [] -> tick' tickState nextEffectFns +and private applyTime effect state = + let totalTurnTime = effectMinutes effect + + if totalTurnTime > 0 then + applyTime' state totalTurnTime + else + // The effect didn't consume any time, so no need to do anything. + [] + +and private applyTime' state totalTurnTime = + let currentTurnMinutes = Optic.get Lenses.State.turnMinutes_ state + + let total = currentTurnMinutes + totalTurnTime + + if total >= Config.Time.minutesPerDayMoment then + // Enough time has passed to trigger a new day moment, advance the + // time by the number of day moments that have passed and apply those + // to the current chain. + let totalDayMoments = + total / Config.Time.minutesPerDayMoment |> (*) 1 + + [ [ fun state -> advanceDayMoment' state totalDayMoments ] + |> ContinueChain ] + else if total > 0 then + // Not enough time has passed to trigger a new day moment, so just + // update the turn time. + [ [ (Func.toConst [ TurnTimeUpdated total ]) ] |> ContinueChain ] + else + [] + //// Ticks the simulation by applying multiple effects, gathering its associated /// effects and applying them as well. /// Returns a tuple with the list of all the effects that were applied in the /// order in which they were applied and the updated state. -let rec tickMultiple currentState effects = +let tickMultiple currentState effects = let effectFns = fun _ -> effects let tickResult = diff --git a/src/Duets.Simulation/Social/Social.Actions.fs b/src/Duets.Simulation/Social/Social.Actions.fs index 670349a4..df739a50 100644 --- a/src/Duets.Simulation/Social/Social.Actions.fs +++ b/src/Duets.Simulation/Social/Social.Actions.fs @@ -23,12 +23,6 @@ let stopConversation state = match currentSituation with | Socializing socializingState -> - let timeAdvanceEffects = - Queries.InteractionTime.timeRequired ( - SocialInteraction.StopConversation |> Interaction.Social - ) - |> AdvanceTime.advanceDayMoment' state - let relationshipUpdateEffects = match socializingState.Relationship with | Some relationship -> @@ -38,9 +32,7 @@ let stopConversation state = |> RelationshipChanged ] | None -> [] - [ yield! relationshipUpdateEffects - yield! timeAdvanceEffects - Situations.freeRoam ] + [ yield! relationshipUpdateEffects; Situations.freeRoam ] | _ -> [] (* Not socializing, nothing to do. *) /// Greets the NPC of the current conversation. diff --git a/src/Duets.Simulation/Social/Social.Common.fs b/src/Duets.Simulation/Social/Social.Common.fs index d3e8ea62..0865c264 100644 --- a/src/Duets.Simulation/Social/Social.Common.fs +++ b/src/Duets.Simulation/Social/Social.Common.fs @@ -98,6 +98,7 @@ and private performAction' state socializingState action = |> responseFromPoints state socializingState |> addAction action.Kind |> addSituationEffect + |> addActionPerformedEffect socializingState action and private responseFromPoints state socializingState points = let cityId, _, _ = Queries.World.currentCoordinates state @@ -136,3 +137,7 @@ and private addSituationEffect response = Situation.Socializing response.SocializingState |> SituationChanged |> Response.addEffect response + +and private addActionPerformedEffect socializingState action response = + SocialActionPerformed(socializingState, action.Kind) + |> Response.addEffect response diff --git a/src/Duets.Simulation/Songs/Composition/ComposeSong.fs b/src/Duets.Simulation/Songs/Composition/ComposeSong.fs index e4b54c52..b7fe26cd 100644 --- a/src/Duets.Simulation/Songs/Composition/ComposeSong.fs +++ b/src/Duets.Simulation/Songs/Composition/ComposeSong.fs @@ -17,14 +17,6 @@ let composeSong state song = let initialQuality = calculateQualityIncreaseOf initialUnfinishedSong - let songStartedEffect = - Unfinished(song, maximumQuality, initialQuality) - |> Tuple.two band - |> SongStarted - - [ songStartedEffect - yield! - RehearsalInteraction.ComposeNewSong - |> Interaction.Rehearsal - |> Queries.InteractionTime.timeRequired - |> AdvanceTime.advanceDayMoment' state ] + [ Unfinished(song, maximumQuality, initialQuality) + |> Tuple.two band + |> SongStarted ] diff --git a/src/Duets.Simulation/Songs/Composition/ImproveSong.fs b/src/Duets.Simulation/Songs/Composition/ImproveSong.fs index 7ad43e0b..974a2426 100644 --- a/src/Duets.Simulation/Songs/Composition/ImproveSong.fs +++ b/src/Duets.Simulation/Songs/Composition/ImproveSong.fs @@ -19,12 +19,7 @@ let private improveSong' state band song maxQuality (quality: Quality) = let songWithUpdatedQualities = Unfinished(song, maxQuality, updatedQuality) let effects = - [ SongImproved(band, Diff(songBeforeUpgrade, songWithUpdatedQualities)) - yield! - RehearsalInteraction.ImproveSong [] - |> Interaction.Rehearsal - |> Queries.InteractionTime.timeRequired - |> AdvanceTime.advanceDayMoment' state ] + [ SongImproved(band, Diff(songBeforeUpgrade, songWithUpdatedQualities)) ] if canBeFurtherImproved then (CanBeImproved, effects) diff --git a/src/Duets.Simulation/Songs/Practice.fs b/src/Duets.Simulation/Songs/Practice.fs index 681f0e1d..6631d839 100644 --- a/src/Duets.Simulation/Songs/Practice.fs +++ b/src/Duets.Simulation/Songs/Practice.fs @@ -25,10 +25,4 @@ let practiceSong state band (finishedSong: Finished) = let songWithPractice = Finished(updatedSong, quality) - [ SongPracticed(band, songWithPractice) - yield! - RehearsalInteraction.PracticeSong [] - |> Interaction.Rehearsal - |> Queries.InteractionTime.timeRequired - |> AdvanceTime.advanceDayMoment' state ] - |> SongImproved + [ SongPracticed(band, songWithPractice) ] |> SongImproved diff --git a/src/Duets.Simulation/State/Calendar.fs b/src/Duets.Simulation/State/Calendar.fs index e05f626d..8cb7ecd2 100644 --- a/src/Duets.Simulation/State/Calendar.fs +++ b/src/Duets.Simulation/State/Calendar.fs @@ -4,3 +4,6 @@ open Aether open Duets.Entities let setTime time = Optic.set Lenses.State.today_ time + +let setTurnMinutes time = + Optic.set Lenses.State.turnMinutes_ time diff --git a/src/Duets.Simulation/State/State.fs b/src/Duets.Simulation/State/State.fs index 6436e51f..bfa3a32c 100644 --- a/src/Duets.Simulation/State/State.fs +++ b/src/Duets.Simulation/State/State.fs @@ -30,11 +30,14 @@ let applyEffect state effect = Albums.removeReleased band album.Id state |> Albums.addReleased band releasedAlbum + | AlbumSongAdded _ -> state + | Ate _ -> state | BalanceUpdated(account, Diff(_, balance)) -> Bank.setBalance account (Incoming(0m
, balance)) state | BandFansChanged(band, Diff(_, fans)) -> Bands.changeFans band fans state | BandSwitchedGenre(band, Diff(_, genre)) -> Bands.changeGenre band genre state + | BookRead _ -> state | CareerAccept(_, job) -> Career.set (Some job) state | CareerLeave _ -> Career.set None state | CareerPromoted(job, _) -> Career.set (Some job) state @@ -63,8 +66,12 @@ let applyEffect state effect = Concerts.removeScheduledConcert band concert state |> Concerts.addPastConcert band pastConcert + | ConcertSoundcheckPerformed -> state + | Drank _ -> state + | Exercised _ -> state | FlightBooked flight -> Flights.addBooking flight state | FlightUpdated flight -> Flights.change flight state + | FlightLanded _ -> state | GameCreated state -> state | GenreMarketsUpdated genreMarkets -> Market.set genreMarkets state | ItemAddedToCharacterInventory item -> Inventory.addToCharacter item state @@ -87,6 +94,7 @@ let applyEffect state effect = (fun state (item, quantity) -> Inventory.reduceForBand band.Id item quantity state) state + | MerchStandSetup -> state | MemberHired(band, character, currentMember, skills) -> let stateWithMember = Characters.add character state |> Bands.addMember band currentMember @@ -99,6 +107,7 @@ let applyEffect state effect = | MemberFired(band, currentMember, pastMember) -> Bands.removeMember band currentMember state |> Bands.addPastMember band pastMember + | MiniGamePlayed _ -> state | NotificationScheduled(date, dayMoment, notification) -> Notifications.schedule date dayMoment notification state | NotificationShown _ -> state @@ -107,7 +116,7 @@ let applyEffect state effect = | MoneyEarned(account, transaction) -> Bank.setBalance account transaction state | PlaceClosed _ -> state - | PlayResult _ -> state + | GamePlayed _ -> state | RelationshipChanged(npc, cityId, relationship) -> Relationships.changeForCharacterId npc.Id relationship state |> Relationships.changeForCityId npc.Id cityId relationship @@ -120,6 +129,7 @@ let applyEffect state effect = Optic.set Lenses.State.situation_ situation state | SkillImproved(character, Diff(_, skill)) -> Skills.add character.Id skill state + | SocialActionPerformed _ -> state | SocialNetworkAccountCreated(socialNetworkKey, socialNetworkAccount) -> SocialNetworks.addAccount socialNetworkKey socialNetworkAccount state | SocialNetworkAccountFollowersChanged(socialNetworkKey, @@ -160,6 +170,8 @@ let applyEffect state effect = Songs.removeUnfinished band song.Id state | TimeAdvanced time -> Calendar.setTime time state + | TurnTimeUpdated minutes -> Calendar.setTurnMinutes minutes state + | WatchedTv _ -> state | WorldEnterRoom(Diff(_, (cityId, placeId, romId))) -> World.move cityId placeId romId state | WorldMoveToPlace(Diff(_, (cityId, placeId, roomId))) -> diff --git a/src/Duets.Simulation/Studio/RecordAlbum.fs b/src/Duets.Simulation/Studio/RecordAlbum.fs index b0ecf7c1..96fe63f8 100644 --- a/src/Duets.Simulation/Studio/RecordAlbum.fs +++ b/src/Duets.Simulation/Studio/RecordAlbum.fs @@ -62,14 +62,8 @@ let private generateEffectsAfterBilling let billingResult = generatePaymentForOneSong state studio selectedProducer band - let timeEffects = - StudioInteraction.CreateAlbum(studio, []) - |> Interaction.Studio - |> Queries.InteractionTime.timeRequired - |> AdvanceTime.advanceDayMoment' state - match billingResult with - | Ok billingEffects -> Ok(effects @ billingEffects @ timeEffects) + | Ok billingEffects -> Ok(effects @ billingEffects) | Error error -> Error error /// Applies the improvement in quality given by the producer of the given studio @@ -109,11 +103,12 @@ let recordSongForAlbum trackList @ [ recordedSong ] |> Album.updateTrackList unreleasedAlbum.Album - [ AlbumUpdated( - band, - { unreleasedAlbum with - Album = updatedAlbum } - ) ] + let updatedUnreleasedAlbum = + { unreleasedAlbum with + Album = updatedAlbum } + + [ AlbumSongAdded(band, updatedUnreleasedAlbum, recordedSong) + AlbumUpdated(band, updatedUnreleasedAlbum) ] |> generateEffectsAfterBilling state studio diff --git a/src/Duets.Simulation/Time/AdvanceTime.fs b/src/Duets.Simulation/Time/AdvanceTime.fs index 819665b2..0171a491 100644 --- a/src/Duets.Simulation/Time/AdvanceTime.fs +++ b/src/Duets.Simulation/Time/AdvanceTime.fs @@ -8,13 +8,18 @@ open Duets.Simulation /// Also handles the cases in which it's already midnight, in which case it'll /// return the dawn of next day. let advanceDayMoment (currentTime: Date) (times: int) = - [ 1 .. (times / 1) ] - |> List.mapFold - (fun time _ -> - Calendar.Query.next time - |> fun advancedTime -> (TimeAdvanced advancedTime, advancedTime)) - currentTime - |> fst + let timeEffects = + [ 1 .. (times / 1) ] + |> List.mapFold + (fun time _ -> + Calendar.Query.next time + |> fun advancedTime -> + (TimeAdvanced advancedTime, advancedTime)) + currentTime + |> fst + // Important! Reset the turn time after advancing time to make sure + // the next turn time is not shorter than expected. + [ yield! timeEffects; TurnTimeUpdated 0 ] /// Same as advanceDayMoment but queries the current time automatically. let advanceDayMoment' state times = diff --git a/src/Duets.Simulation/Time/InteractionMinutes.fs b/src/Duets.Simulation/Time/InteractionMinutes.fs new file mode 100644 index 00000000..af1dba99 --- /dev/null +++ b/src/Duets.Simulation/Time/InteractionMinutes.fs @@ -0,0 +1,35 @@ +module Duets.Simulation.Time.InteractionMinutes + +open Duets.Entities +open Duets.Simulation + +/// Returns the number of minutes that a given effect takes to perform. +let effectMinutes = + function + | AlbumStarted _ + | AlbumSongAdded _ -> 2 * Config.Time.minutesPerDayMoment + | Ate _ -> 25 + | BookRead _ -> 60 + | CareerShiftPerformed(_, shiftDuration, _) -> + shiftDuration |> Calendar.DayMoments.toMinutes + | ConcertFinished _ -> Config.Time.minutesPerDayMoment + | ConcertSoundcheckPerformed -> 45 + | Drank _ -> 15 + | Exercised _ -> 60 + | FlightLanded flight -> + Queries.Flights.flightTime flight |> Calendar.Seconds.toMinutes + | GamePlayed _ -> 30 + | MerchStandSetup -> 30 + | MiniGamePlayed _ -> 30 + | SocialActionPerformed(_, actionKind) -> + match actionKind with + | SocialActionKind.Greet -> 5 + | SocialActionKind.Chat -> 15 + | SocialActionKind.AskAboutDay -> 10 + | SocialActionKind.TellStory -> 30 + | SongImproved _ + | SongPracticed _ + | SongStarted _ -> 120 + | WatchedTv _ -> 30 + | Wait dayMoments -> dayMoments |> Calendar.DayMoments.toMinutes + | _ -> 0 diff --git a/tests/Simulation.Tests/Careers/Work.Test.fs b/tests/Simulation.Tests/Careers/Work.Test.fs index 30d66ba5..7ee69b98 100644 --- a/tests/Simulation.Tests/Careers/Work.Test.fs +++ b/tests/Simulation.Tests/Careers/Work.Test.fs @@ -1,5 +1,7 @@ module Duets.Simulation.Tests.Careers.Work +#nowarn "25" + open FsCheck open FsUnit open Fugit.Months @@ -45,9 +47,12 @@ type ``When place is not near closing time``() = = Work.workShift state job |> List.filter (function - | TimeAdvanced _ -> true + | CareerShiftPerformed _ -> true | _ -> false) - |> should haveLength 2 + |> List.head + |> fun (CareerShiftPerformed(_, shiftDuration, _)) -> + shiftDuration |> should equal 2 + [] type ``When place is near closing time``() = @@ -61,6 +66,8 @@ type ``When place is near closing time``() = = let effect = Work.workShift stateInEvening job + |> Simulation.tickMultiple stateInEvening + |> fst |> List.filter (function | MoneyEarned _ -> true | _ -> false) @@ -75,6 +82,8 @@ type ``When place is near closing time``() = () = Work.workShift stateInEvening job + |> Simulation.tickMultiple stateInEvening + |> fst |> List.filter (function | TimeAdvanced _ -> true | _ -> false) diff --git a/tests/Simulation.Tests/Events/Career.Events.Tests.fs b/tests/Simulation.Tests/Events/Career.Events.Tests.fs index 01677ed2..43eea436 100644 --- a/tests/Simulation.Tests/Events/Career.Events.Tests.fs +++ b/tests/Simulation.Tests/Events/Career.Events.Tests.fs @@ -1,5 +1,7 @@ module Duets.Simulation.Tests.Events.Career +#nowarn "25" + open FsUnit open NUnit.Framework open Test.Common @@ -21,7 +23,8 @@ let bartenderJob = let baristaSkill = Skill.create SkillId.Barista let bartendingSkill = Skill.create SkillId.Bartending -let shiftPerformedEffect job = CareerShiftPerformed(job, 100m
) +let shiftPerformedEffect job = + CareerShiftPerformed(job, 2, 100m
) (* --------- Skill improvement. --------- *) @@ -35,8 +38,10 @@ let ``tick of CareerShiftPerformed should improve career skill if chance of 25% Simulation.tickOne dummyState (shiftPerformedEffect baristaJob) |> fst - |> List.item 1 - |> should be (ofCase <@ SkillImproved @>)) + |> List.filter (function + | SkillImproved _ -> true + | _ -> false) + |> should haveLength 1) [] let ``tick of CareerShiftPerformed does not improve career skill if chance of 25% fails`` @@ -48,7 +53,10 @@ let ``tick of CareerShiftPerformed does not improve career skill if chance of 25 Simulation.tickOne dummyState (shiftPerformedEffect baristaJob) |> fst - |> should haveLength 1) + |> List.filter (function + | SkillImproved _ -> true + | _ -> false) + |> should haveLength 0) [] let ``tick of CareerShiftPerformed with successful chance improves job career by 1`` @@ -60,13 +68,12 @@ let ``tick of CareerShiftPerformed with successful chance improves job career by |> List.iter (fun (job, expectedSkill) -> Simulation.tickOne dummyState (shiftPerformedEffect job) |> fst - |> List.item 1 - |> should - equal - (SkillImproved( - dummyCharacter, - Diff((expectedSkill, 0), (expectedSkill, 1)) - ))) + |> List.filter (function + | SkillImproved _ -> true + | _ -> false) + |> List.head + |> fun (SkillImproved(_, diff)) -> + diff |> should equal (Diff((expectedSkill, 0), (expectedSkill, 1)))) (* --------- Promotions --------- *) diff --git a/tests/Simulation.Tests/Interactions/Exercise.Interactions.Test.fs b/tests/Simulation.Tests/Interactions/Exercise.Interactions.Test.fs index 3fc94b35..1e091b53 100644 --- a/tests/Simulation.Tests/Interactions/Exercise.Interactions.Test.fs +++ b/tests/Simulation.Tests/Interactions/Exercise.Interactions.Test.fs @@ -30,16 +30,6 @@ let ``exercising in non-gym equipment is not allowed`` () = |> Result.unwrapError |> should equal Items.ActionNotPossible) -[] -let ``exercising in gym equipment advances time by one day moment`` () = - Items.perform - state - (fst Items.Gym.Treadmills.elliptical) - ItemInteraction.Exercise - |> Result.unwrap - |> List.item 0 - |> should be (ofCase <@ TimeAdvanced @>) - [] let ``exercising in gym equipment decreases energy`` () = Items.perform diff --git a/tests/Simulation.Tests/Interactions/Play.Interactions.Test.fs b/tests/Simulation.Tests/Interactions/Play.Interactions.Test.fs index a01a979d..960d0d17 100644 --- a/tests/Simulation.Tests/Interactions/Play.Interactions.Test.fs +++ b/tests/Simulation.Tests/Interactions/Play.Interactions.Test.fs @@ -30,7 +30,7 @@ let ``playing with a video-game console returns a video-game result`` () = ItemInteraction.Play |> Result.unwrap |> List.filter (function - | PlayResult(PlayResult.VideoGame) -> true + | GamePlayed(PlayResult.VideoGame) -> true | _ -> false) |> should haveLength 1 @@ -46,7 +46,7 @@ let ``playing in a dartboard has a 50% chance of returning a winning dart result ItemInteraction.Play |> Result.unwrap |> List.filter (function - | PlayResult(PlayResult.Darts(SimpleResult.Win)) -> true + | GamePlayed(PlayResult.Darts(SimpleResult.Win)) -> true | _ -> false) |> should haveLength 1 @@ -62,7 +62,7 @@ let ``playing in a dartboard has a 50% chance of returning a losing dart result` ItemInteraction.Play |> Result.unwrap |> List.filter (function - | PlayResult(PlayResult.Darts(SimpleResult.Lose)) -> true + | GamePlayed(PlayResult.Darts(SimpleResult.Lose)) -> true | _ -> false) |> should haveLength 1 @@ -78,7 +78,7 @@ let ``playing in a billiard has a 50% chance of returning a winning pool result` ItemInteraction.Play |> Result.unwrap |> List.filter (function - | PlayResult(PlayResult.Pool(SimpleResult.Win)) -> true + | GamePlayed(PlayResult.Pool(SimpleResult.Win)) -> true | _ -> false) |> should haveLength 1 @@ -94,6 +94,6 @@ let ``playing in a billiard has a 50% chance of returning a losing pool result`` ItemInteraction.Play |> Result.unwrap |> List.filter (function - | PlayResult(PlayResult.Pool(SimpleResult.Lose)) -> true + | GamePlayed(PlayResult.Pool(SimpleResult.Lose)) -> true | _ -> false) |> should haveLength 1 diff --git a/tests/Simulation.Tests/MiniGames/Blackjack.Tests.fs b/tests/Simulation.Tests/MiniGames/Blackjack.Tests.fs index 68eafaae..fb9265cc 100644 --- a/tests/Simulation.Tests/MiniGames/Blackjack.Tests.fs +++ b/tests/Simulation.Tests/MiniGames/Blackjack.Tests.fs @@ -350,7 +350,7 @@ let ``standing when the dealer has less than 17 triggers a turn for the dealer`` [] let ``leaving sets the situation back to free roam and increase time`` () = - let effects = Blackjack.leave dummyState Betting |> Result.unwrap + let effects = Blackjack.leave Betting |> Result.unwrap effects |> List.head |> should be (ofCase (<@ SituationChanged @>)) - effects |> List.item 1 |> should be (ofCase (<@ TimeAdvanced @>)) + effects |> List.item 1 |> should be (ofCase (<@ MiniGamePlayed @>)) diff --git a/tests/Simulation.Tests/Simulation.Tests.fs b/tests/Simulation.Tests/Simulation.Tests.fs index 8e8713d5..2986aaeb 100644 --- a/tests/Simulation.Tests/Simulation.Tests.fs +++ b/tests/Simulation.Tests/Simulation.Tests.fs @@ -1,6 +1,7 @@ module Duets.Simulation.Tests.Simulation open System +open Aether open FsUnit open Fugit.Months open NUnit.Framework @@ -11,8 +12,11 @@ open Test.Common.Generators open Duets.Entities open Duets.Simulation +open Duets.Data.Careers -let state = { dummyState with Today = dummyTodayMiddleOfYear } +let state = + { dummyState with + Today = dummyTodayMiddleOfYear } let stateInMorning = { state with @@ -20,9 +24,7 @@ let stateInMorning = let stateInMidnightBeforeNewYear = { state with - Today = - January 1 2023 - |> Calendar.Transform.changeDayMoment Midnight } + Today = January 1 2023 |> Calendar.Transform.changeDayMoment Midnight } let unfinishedSong = Unfinished(dummySong, 10, 10) @@ -36,9 +38,11 @@ let checkTimeIncrease timeIncrease effects = |> List.head) [] -let ``tick does not try to apply moodlets (breaks) for game created effect`` () = +let ``tick does not try to apply moodlets (breaks) for game created effect`` + () + = let gameStartedEffect = GameCreated state - + (fun () -> Simulation.tickOne State.empty gameStartedEffect |> ignore) |> should not' (throw typeof) @@ -66,7 +70,7 @@ let ``tick should gather and apply associated effects`` () = |> fst effects - |> List.head + |> List.item 0 |> should equal (TimeAdvanced(DateTime(2021, 6, 20, 10, 0, 0))) effects @@ -144,7 +148,8 @@ let ``tick should update album streams every day`` () = let ``tick should update all scheduled concerts every day`` () = let state = State.generateOne - { State.defaultOptions with FutureConcertsToGenerate = 10 } + { State.defaultOptions with + FutureConcertsToGenerate = 10 } AdvanceTime.advanceDayMoment' state 1 |> Simulation.tickMultiple state @@ -184,7 +189,8 @@ let ``tick should update markets every year in the early morning`` () = let ``tick should check for failed concerts in every time update`` () = let state = State.generateOne - { State.defaultOptions with FutureConcertsToGenerate = 0 } + { State.defaultOptions with + FutureConcertsToGenerate = 0 } |> State.Concerts.addScheduledConcert dummyBand (ScheduledConcert(dummyConcert, dummyToday)) @@ -205,3 +211,72 @@ let ``tick should check for failed concerts in every time update`` () = | ConcertCancelled _ -> true | _ -> false) |> should haveLength 1 + +[] +let ``tick should update turn time with the total minutes spent in the tick`` + () + = + Simulation.tickOne state songStartedEffect + |> snd + |> Optic.get Lenses.State.turnMinutes_ + |> should equal 120 + +[] +let ``tick should advance day moment if the effects triggered enough time`` () = + let effects, stateAfterTick = + Simulation.tickMultiple state [ songStartedEffect; songStartedEffect ] + + effects + |> List.find (function + | TimeAdvanced _ -> true + | _ -> false) + |> should equal (TimeAdvanced(DateTime(2021, 6, 20, 10, 0, 0))) + + stateAfterTick + |> Optic.get Lenses.State.turnMinutes_ + |> should equal 0 + +[] +let ``tick should keep leftover time after advancing day moment if effects triggered enough time`` + () + = + let effects, stateAfterTick = + Simulation.tickMultiple + state + [ songStartedEffect; songStartedEffect; songStartedEffect ] + + effects + |> List.find (function + | TimeAdvanced _ -> true + | _ -> false) + |> should equal (TimeAdvanced(DateTime(2021, 6, 20, 10, 0, 0))) + + stateAfterTick + |> Optic.get Lenses.State.turnMinutes_ + |> should equal 120 + +[] +let ``ticks that include effects spanning multiple day moments get applied correctly`` + () + = + let baristaManagerCareer = BaristaCareer.stages |> List.last + + let effects, stateAfterTick = + CareerShiftPerformed( + { Id = Barista + CurrentStage = baristaManagerCareer + Location = (Prague, "") }, + 4, + 0.0m
+ ) + |> Simulation.tickOne state + + effects + |> List.find (function + | TimeAdvanced _ -> true + | _ -> false) + |> should equal (TimeAdvanced(DateTime(2021, 6, 20, 10, 0, 0))) + + stateAfterTick + |> Optic.get Lenses.State.turnMinutes_ + |> should equal 0 diff --git a/tests/Simulation.Tests/Songs/ComposeSong.Tests.fs b/tests/Simulation.Tests/Songs/ComposeSong.Tests.fs index 798429fb..18efec38 100644 --- a/tests/Simulation.Tests/Songs/ComposeSong.Tests.fs +++ b/tests/Simulation.Tests/Songs/ComposeSong.Tests.fs @@ -21,12 +21,6 @@ let ``composeSong should generate a SongStarted effect`` () = ) @>) -[] -let ``composeSong should advance time 1 day moment`` () = - composeSong dummyState dummySong - |> List.item 1 - |> should be (ofCase <@ TimeAdvanced(dummyTodayOneDayMomentAfter) @>) - [] let ``Qualities are calculated based on member skills`` () = let state = @@ -42,10 +36,7 @@ let ``Qualities are calculated based on member skills`` () = |> List.head |> should equal - (SongStarted( - dummyBand, - Unfinished(dummySong, 33, 7) - )) + (SongStarted(dummyBand, Unfinished(dummySong, 33, 7))) [] let ``Qualities should be calculated based on members skills but never go above 100`` diff --git a/tests/Simulation.Tests/Songs/ImproveSong.Tests.fs b/tests/Simulation.Tests/Songs/ImproveSong.Tests.fs index 227bbb44..2e02c63c 100644 --- a/tests/Simulation.Tests/Songs/ImproveSong.Tests.fs +++ b/tests/Simulation.Tests/Songs/ImproveSong.Tests.fs @@ -37,7 +37,6 @@ let ``Should improve song if it's possible, return CanBeImproved and advance one fst result |> should be (ofCase <@ CanBeImproved @>) snd result |> should contain (createSongImprovedEffect dummySong 35 7 14) - snd result |> should contain (TimeAdvanced(dummyTodayOneDayMomentAfter)) [] let ``Should make improvement process slower the longer the song is`` () = @@ -64,10 +63,7 @@ let ``Should make improvement process slower the longer the song is`` () = fst result |> should be (ofCase <@ CanBeImproved @>) snd result - |> should contain (createSongImprovedEffect song 50 0 expectedQuality) - - snd result - |> should contain (TimeAdvanced(dummyTodayOneDayMomentAfter))) + |> should contain (createSongImprovedEffect song 50 0 expectedQuality)) [] let ``Should improve for one last time if possible, return ReachedMaxQualityInLastImprovement and advance one day moment`` @@ -85,7 +81,6 @@ let ``Should improve for one last time if possible, return ReachedMaxQualityInLa fst result |> should be (ofCase <@ ReachedMaxQualityInLastImprovement @>) snd result |> should contain (createSongImprovedEffect dummySong 35 28 35) - snd result |> should contain (TimeAdvanced(dummyTodayOneDayMomentAfter)) [] let ``Should not allow improvement if it already reached max quality and return ReachedMaxQualityAlready`` diff --git a/tests/Simulation.Tests/Studio/RecordAlbum.Tests.fs b/tests/Simulation.Tests/Studio/RecordAlbum.Tests.fs index 36259a9e..e484067a 100644 --- a/tests/Simulation.Tests/Studio/RecordAlbum.Tests.fs +++ b/tests/Simulation.Tests/Studio/RecordAlbum.Tests.fs @@ -181,8 +181,6 @@ let ``startAlbum should generate AlbumRecorded and MoneyTransferred`` () = dummyFinishedSong |> Result.unwrap |> fun effects -> - effects |> should haveLength 4 - effects |> List.item 0 |> should be (ofCase <@ AlbumStarted @>) effects diff --git a/tests/Simulation.Tests/Time/AdvanceTime.Tests.fs b/tests/Simulation.Tests/Time/AdvanceTime.Tests.fs index af81dedb..778f87c5 100644 --- a/tests/Simulation.Tests/Time/AdvanceTime.Tests.fs +++ b/tests/Simulation.Tests/Time/AdvanceTime.Tests.fs @@ -29,8 +29,6 @@ let hourMatches (hour: int) time = let ``advanceDayMoment should return next day moment`` () = let effects = advanceDayMoment Calendar.gameBeginning 1 - effects |> should haveLength 1 - List.head effects |> dateMatches Calendar.gameBeginning |> hourMatches 10 [] @@ -42,8 +40,6 @@ let ``advanceDayMoment should roll over next day if current day moment is midnig let effects = advanceDayMoment initialDate 1 - effects |> should haveLength 1 - List.head effects |> dateMatches (Calendar.gameBeginning + oneDay) |> hourMatches 0 @@ -52,10 +48,13 @@ let ``advanceDayMoment should roll over next day if current day moment is midnig let ``advanceDayMoment 2 should return 2 day moments later`` () = let effects = advanceDayMoment Calendar.gameBeginning 2 - effects |> should haveLength 2 - effects - |> List.rev - |> List.head + |> List.item 1 |> dateMatches Calendar.gameBeginning |> hourMatches 14 + +[] +let ``advanceDayMoment should reset turn minutes`` () = + let effects = advanceDayMoment Calendar.gameBeginning 1 + + effects |> should contain (TurnTimeUpdated 0)