diff options
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/SampleTests.fs | 60 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/Game.fs | 34 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/SampleScript.fs | 161 |
5 files changed, 252 insertions, 5 deletions
diff --git a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj index 3a9a142..50cb380 100644 --- a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj +++ b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj @@ -10,6 +10,7 @@ <Compile Include="M6aTests.fs" /> <Compile Include="M6bTests.fs" /> <Compile Include="PrototypeTests.fs" /> + <Compile Include="SampleTests.fs" /> </ItemGroup> <ItemGroup> diff --git a/src/LivingVillage.Desktop.Tests/SampleTests.fs b/src/LivingVillage.Desktop.Tests/SampleTests.fs new file mode 100644 index 0000000..4c833b5 --- /dev/null +++ b/src/LivingVillage.Desktop.Tests/SampleTests.fs @@ -0,0 +1,60 @@ +namespace LivingVillage.Desktop.Tests + +open System +open Microsoft.VisualStudio.TestTools.UnitTesting +open LivingVillage.Kernel +open LivingVillage.Kernel.Sim +open LivingVillage.Desktop +open LivingVillage.Desktop.VillagePresentation + +[<TestClass>] +type SampleTests () = + + let areEqual (expected: 'T) (actual: 'T) = Assert.AreEqual<'T>(expected, actual) + + let freshWorld () = Sim.initialWorldN 42UL Sim.npcCount + + let freshView (world: World) = M5Interaction.refreshPrompt world M5Interaction.initial + + let driveUntil (maxFrames: int) (stop: SampleScript.SampleState -> bool) = + let mutable world = freshWorld () + let mutable view = freshView world + let mutable state = SampleScript.initial + let mutable frames = 0 + while frames < maxFrames && not (stop state) do + let nextWorld, nextView, nextState = SampleScript.runFrame world view state + world <- nextWorld + view <- nextView + state <- nextState + frames <- frames + 1 + world, view, state, frames + + [<TestMethod>] + member _.SampleScriptStartsWalkingTowardHomeDoor () = + let spawnWorld = freshWorld () + let movedWorld = + List.fold (fun w _ -> Sim.step { Input = { MoveX = -1.0f; MoveY = 0.0f } } w) spawnWorld [ 1..12 ] + let view = freshView movedWorld + let state, action = SampleScript.step movedWorld view SampleScript.initial + areEqual SampleScript.ApproachDoor state.Stage + match action with + | SampleScript.MoveTo target -> areEqual SampleScript.doorWorldCenter target + | other -> Assert.Fail(sprintf "expected MoveTo toward the door, got %A" other) + + [<TestMethod>] + member _.SampleScriptEntersTheHomeThroughTheDoor () = + let _world, view, state, frames = driveUntil 2400 (fun s -> s.Stage = SampleScript.InspectInterior) + Assert.IsTrue( + frames < 2400, + sprintf "home entry never confirmed; stage=%A frames=%d" state.Stage frames) + areEqual (Inside (HomeId 1)) view.HomeMode + + [<TestMethod>] + member _.SampleScriptCompletesTheVillageTourWithADialogue () = + let _world, view, state, frames = + driveUntil 22000 (fun s -> s.Stage = SampleScript.SampleComplete) + areEqual SampleScript.SampleComplete state.Stage + Assert.IsFalse(state.TimedOut, sprintf "tour timed out; stage=%A frames=%d" state.Stage frames) + Assert.IsTrue(state.DialogueTarget.IsSome, "no dialogue was opened during the tour") + areEqual Outside view.HomeMode + areEqual WorldPanel view.Panel diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs index 514928f..1245e02 100644 --- a/src/LivingVillage.Desktop/Game.fs +++ b/src/LivingVillage.Desktop/Game.fs @@ -96,9 +96,11 @@ type LivingVillageGame() as this = let autoplay = Environment.GetEnvironmentVariable("LV_AUTOPLAY") = "1" let autoplayFlow = Environment.GetEnvironmentVariable("LV_AUTOPLAY_FLOW") = "1" + let sampleMode = Environment.GetEnvironmentVariable("LV_AUTOPLAY_SAMPLE") = "1" let automated = autoplay || autoplayFlow let modeName = - if autoplayFlow then "autoplay-flow" + if sampleMode then "sample" + elif autoplayFlow then "autoplay-flow" elif autoplay then "autoplay" else "keyboard" let configuredStepsPerFrame = @@ -110,6 +112,8 @@ type LivingVillageGame() as this = | _ -> 1 let initialSimulationControl, initialLegacyStepsPerFrame = SimulationControl.initialForConfiguredSteps configuredStepsPerFrame + let startSimulationControl = + if sampleMode then SimulationControl.setSpeed TwoX initialSimulationControl else initialSimulationControl let savePath = match Environment.GetEnvironmentVariable("LV_SAVE_PATH") with | null | "" -> "living-village.save" @@ -129,11 +133,12 @@ type LivingVillageGame() as this = let mutable relationView = false let mutable relationSnapshot: float32[,] option = None let mutable m5View = M5Interaction.initial - let mutable simulationControl = initialSimulationControl - let mutable legacyStepsPerFrame = initialLegacyStepsPerFrame - let mutable menu = MenuState.create initialSimulationControl false + let mutable simulationControl = startSimulationControl + let mutable legacyStepsPerFrame = (if sampleMode then None else initialLegacyStepsPerFrame) + let mutable menu = MenuState.create startSimulationControl false let mutable autoplayFrames = 0 let mutable flowStep = 0 + let mutable sampleState = SampleScript.initial do graphics.PreferredBackBufferWidth <- 1280 @@ -235,13 +240,32 @@ type LivingVillageGame() as this = else None match input with | Some nextInput -> this.DispatchMenuInput nextInput - | None when autoplay && not autoplayFlow && menu.Page = MainMenu && not menu.HasCurrentWorld -> + | None when (autoplay || sampleMode) && not autoplayFlow && menu.Page = MainMenu && not menu.HasCurrentWorld -> autoplayFrames <- autoplayFrames + 1 if autoplayFrames >= 15 then this.DispatchMenuInput Confirm | None -> () + member private this.RunSampleMode () = + let stageBefore = sampleState.Stage + let positionBefore = world.Avatar.Pos + let nextWorld, nextView, nextState = SampleScript.runFrame world m5View sampleState + if nextWorld.Avatar.Pos <> positionBefore then + avatarFacing <- VillageArt.facingAfterMovement positionBefore nextWorld.Avatar.Pos avatarFacing + world <- nextWorld + m5View <- nextView + sampleState <- nextState + this.CenterCamera() + if nextState.Stage <> stageBefore then + printfn $"sample stage={nextState.Stage} tick={nextWorld.Tick} pos=({nextWorld.Avatar.Pos.X:F0},{nextWorld.Avatar.Pos.Y:F0})" + member private this.UpdatePlaying (gameTime: GameTime) (kb: KeyboardState) (pressed: Keys -> bool) (pressedAny: Keys list -> bool) = + if sampleMode then + this.RunSampleMode() + else + this.UpdatePlayingManual gameTime kb pressed pressedAny + + member private this.UpdatePlayingManual (gameTime: GameTime) (kb: KeyboardState) (pressed: Keys -> bool) (pressedAny: Keys list -> bool) = let mutable loadFailed = false let mutable leftGame = false let lPressed = pressed Keys.L diff --git a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj index b6b619f..5bd431e 100644 --- a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj +++ b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj @@ -12,6 +12,7 @@ <Compile Include="CjkGlyphAtlas.fs" /> <Compile Include="MenuState.fs" /> <Compile Include="Interaction.fs" /> + <Compile Include="SampleScript.fs" /> <Compile Include="M6Presentation.fs" /> <Compile Include="Game.fs" /> <Compile Include="Program.fs" /> diff --git a/src/LivingVillage.Desktop/SampleScript.fs b/src/LivingVillage.Desktop/SampleScript.fs new file mode 100644 index 0000000..c072161 --- /dev/null +++ b/src/LivingVillage.Desktop/SampleScript.fs @@ -0,0 +1,161 @@ +namespace LivingVillage.Desktop + +open System +open LivingVillage.Kernel +open LivingVillage.Kernel.Sim +open LivingVillage.Desktop.VillagePresentation + +module SampleScript = + + type SampleStage = + | ApproachDoor + | InspectInterior + | LeaveDoorstep + | ApproachNpc + | ReadDialogueOptions + | CloseDialogue + | WalkAway + | SampleComplete + + type SampleAction = + | NoAction + | MoveTo of Vec2 + | PushM5 of M5Command + + type SampleState = + { Stage: SampleStage + StageFrames: int + TotalFrames: int + DialogueTarget: NpcId option + TimedOut: bool } + + let initial : SampleState = + { Stage = ApproachDoor + StageFrames = 0 + TotalFrames = 0 + DialogueTarget = None + TimedOut = false } + + let private tileCenter (tile: TilePosition) : Vec2 = + { X = float32 (tile.X * Sim.tilePixels + Sim.tilePixels / 2) + Y = float32 (tile.Y * Sim.tilePixels + Sim.tilePixels / 2) } + + let doorWorldCenter : Vec2 = + let home = (createScene ()).Homes |> List.head + tileCenter (worldTileForSceneTile home.Door) + + let private leaveDoorstepCenter : Vec2 = + tileCenter (worldTileForSceneTile { X = 3; Y = 5 }) + + let private walkAwayCenter : Vec2 = + tileCenter (worldTileForSceneTile { X = 6; Y = 7 }) + + let private arriveRadius = 12.0f + let private inspectFrames = 150 + let private dialogueHoldFrames = 120 + let private totalFrameLimit = 20000 + + let private distanceSquared (a: Vec2) (b: Vec2) : float32 = + let dx = b.X - a.X + let dy = b.Y - a.Y + dx * dx + dy * dy + + let private timeoutFor (stage: SampleStage) : int = + match stage with + | ApproachDoor -> 1800 + | InspectInterior -> 600 + | LeaveDoorstep -> 1800 + | ApproachNpc -> 5400 + | ReadDialogueOptions -> 120 + | CloseDialogue -> 300 + | WalkAway -> 3600 + | SampleComplete -> Int32.MaxValue + + let private advance (stage: SampleStage) (state: SampleState) : SampleState = + { state with Stage = stage; StageFrames = 0 } + + let private nearestChatableNpc (world: World) : Npc option = + world.Npcs + |> Array.filter chatableForChat + |> Array.sortBy (fun npc -> distanceSquared world.Avatar.Pos npc.Pos, npc.Id) + |> Array.tryHead + + let private timedOut (state: SampleState) : SampleState * SampleAction = + { state with Stage = SampleComplete; TimedOut = true }, NoAction + + let step (world: World) (view: M5View) (state: SampleState) : SampleState * SampleAction = + let state = + { state with StageFrames = state.StageFrames + 1; TotalFrames = state.TotalFrames + 1 } + if state.TotalFrames > totalFrameLimit then + timedOut state + elif state.StageFrames >= timeoutFor state.Stage then + timedOut state + else + match state.Stage with + | SampleComplete -> state, NoAction + | ApproachDoor -> + match view.HomeMode with + | Inside _ -> advance InspectInterior state, NoAction + | Outside -> + if distanceSquared world.Avatar.Pos doorWorldCenter <= arriveRadius * arriveRadius then + state, PushM5 Interact + else + state, MoveTo doorWorldCenter + | InspectInterior -> + match view.HomeMode with + | Outside -> advance LeaveDoorstep state, NoAction + | Inside _ -> + if state.StageFrames >= inspectFrames then + state, PushM5 Interact + else + state, NoAction + | LeaveDoorstep -> + match view.HomeMode with + | Inside _ -> state, PushM5 Interact + | Outside -> + if distanceSquared world.Avatar.Pos leaveDoorstepCenter <= arriveRadius * arriveRadius then + advance ApproachNpc state, NoAction + else + state, MoveTo leaveDoorstepCenter + | ApproachNpc -> + match M5Interaction.resolveAction world Outside with + | Some { Action = TalkTo target } -> + { advance ReadDialogueOptions state with DialogueTarget = Some target }, PushM5 Interact + | _ -> + match nearestChatableNpc world with + | Some npc -> state, MoveTo npc.Pos + | None -> state, NoAction + | ReadDialogueOptions -> + if view.Panel = DialoguePanel && view.Menu.IsSome then + state, PushM5 Intent1 + else + advance CloseDialogue state, NoAction + | CloseDialogue -> + if state.StageFrames >= dialogueHoldFrames then + advance WalkAway state, PushM5 ClosePanel + else + state, NoAction + | WalkAway -> + if distanceSquared world.Avatar.Pos walkAwayCenter <= arriveRadius * arriveRadius then + advance SampleComplete state, NoAction + else + state, MoveTo walkAwayCenter + + let runFrame (world: World) (view: M5View) (state: SampleState) : World * M5View * SampleState = + let nextState, action = step world view state + let nextWorld, nextView = + match action with + | NoAction -> world, view + | PushM5 command -> M5Interaction.apply command world view + | MoveTo target -> + let dx = target.X - world.Avatar.Pos.X + let dy = target.Y - world.Avatar.Pos.Y + let length = sqrt (dx * dx + dy * dy) + let input = + if length > 0.001f then + { MoveX = dx / length; MoveY = dy / length } + else + { MoveX = 0.0f; MoveY = 0.0f } + let movedWorld = Sim.step { Input = input } world + movedWorld, view + nextWorld, M5Interaction.refreshPrompt nextWorld nextView, nextState |