diff options
| -rw-r--r-- | src/LivingVillage.Desktop/Game.fs | 19 | ||||
| -rw-r--r-- | src/LivingVillage.Headless/Program.fs | 83 | ||||
| -rw-r--r-- | src/LivingVillage.Kernel.Tests/DeterminismTests.fs | 60 | ||||
| -rw-r--r-- | src/LivingVillage.Kernel/Sim.fs | 213 |
4 files changed, 291 insertions, 84 deletions
diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs index e2b520f..2e28760 100644 --- a/src/LivingVillage.Desktop/Game.fs +++ b/src/LivingVillage.Desktop/Game.fs @@ -70,6 +70,8 @@ module NpcView = | Sleep -> "sleep" | Wander -> "wander" | Work -> "work" + | Chat -> "chat" + | Work -> "work" type LivingVillageGame() as this = inherit Game() @@ -82,7 +84,7 @@ type LivingVillageGame() as this = let mutable atlas = Unchecked.defaultof<Texture2D> let mutable pixel = Unchecked.defaultof<Texture2D> let mutable map = MapGen.generate Sim.mapWidthTiles Sim.mapHeightTiles - let mutable world = Sim.initialWorld 42UL + let mutable world = Sim.initialWorldN 42UL Sim.npcCount let mutable camera = Vector2.Zero let mutable fpsFrames = 0 let mutable fpsSeconds = 0.0 @@ -139,10 +141,10 @@ type LivingVillageGame() as this = fpsFrames <- 0 fpsSeconds <- 0.0 let npcAction = - match world.Npcs with - | npc :: _ -> NpcView.actionName npc.Mind.Action - | [] -> "none" - this.Window.Title <- $"Living Village M1{titleSuffix} | fps {fps:F1} | tick {world.Tick} | npc {npcAction}" + if world.Npcs.Length > 0 then + NpcView.actionName world.Npcs.[0].Mind.Action + else "none" + this.Window.Title <- $"Living Village M3a{titleSuffix} | fps {fps:F1} | tick {world.Tick} | npc {npcAction}" printfn $"fps={fps:F1} tick={world.Tick} pos=({world.Avatar.Pos.X:F0},{world.Avatar.Pos.Y:F0})" override this.Draw(gameTime: GameTime) = @@ -163,9 +165,12 @@ type LivingVillageGame() as this = spriteBatch.Draw(atlas, dst, src, Color.White) let avatarDst = Rectangle(int world.Avatar.Pos.X - camX, int world.Avatar.Pos.Y - camY, Sim.tilePixels, Sim.tilePixels) - spriteBatch.Draw(pixel, avatarDst, Color.IndianRed) + spriteBatch.Draw(pixel, avatarDst, Color.Red) + let npcShades = + [| Color.Navy; Color.MediumBlue; Color.Blue; Color.RoyalBlue; Color.DodgerBlue |] for npc in world.Npcs do let npcDst = Rectangle(int npc.Pos.X - camX, int npc.Pos.Y - camY, Sim.tilePixels, Sim.tilePixels) - spriteBatch.Draw(pixel, npcDst, Color.Blue) + let (NpcId idx) = npc.Id + spriteBatch.Draw(pixel, npcDst, npcShades.[idx % npcShades.Length]) spriteBatch.End() diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs index 6f86f45..28fe121 100644 --- a/src/LivingVillage.Headless/Program.fs +++ b/src/LivingVillage.Headless/Program.fs @@ -9,6 +9,7 @@ let secondsPerDay = 86400L let ticksPerDay = secondsPerDay * ticksPerSecond let segmentTicks = 900L +let summaryInterval = 5000L let zeroInput = { MoveX = 0.0f; MoveY = 0.0f } @@ -46,18 +47,34 @@ let actionName (k: NpcActionKind) : string = | Sleep -> "sleep" | Wander -> "wander" | Work -> "work" + | Chat -> "chat" -let runSimulation (days: int64) (seed: uint64) : int = +let npcIndex (id: NpcId) : int = + match id with NpcId i -> i + +let actionDistribution (npcs: Npc[]) : int * int * int * int * int = + let counts = + npcs + |> Array.fold (fun (e, s, w, k, c) npc -> + match npc.Mind.Action with + | Eat -> (e + 1, s, w, k, c) + | Sleep -> (e, s + 1, w, k, c) + | Wander -> (e, s, w + 1, k, c) + | Work -> (e, s, w, k + 1, c) + | Chat -> (e, s, w, k, c + 1)) (0, 0, 0, 0, 0) + counts + +let runSimulation (days: int64) (seed: uint64) (npcCount: int) : int = let totalTicks = days * ticksPerDay - printfn "living-village headless days=%d seed=%d ticks=%d tickrate=%d" days seed totalTicks ticksPerSecond - let mutable world = Sim.initialWorld seed + printfn "living-village headless days=%d seed=%d npcs=%d ticks=%d tickrate=%d" days seed npcCount totalTicks ticksPerSecond + let mutable world = Sim.initialWorldN seed npcCount let mutable driver = { Rng = Rng.ofSeed seed; Until = segmentTicks; Input = zeroInput } let maxX = float32 (Sim.mapWidthTiles * Sim.tilePixels - Sim.tilePixels) let maxY = float32 (Sim.mapHeightTiles * Sim.tilePixels - Sim.tilePixels) let mutable nonFinite = 0L let mutable outOfBounds = 0L let mutable t = 0L - let mutable lastAction = (List.head world.Npcs).Mind.Action + let mutable lastAction = (world.Npcs.[0]).Mind.Action let mutable lastStart = 0L let mutable switchCount = 0L let mutable switchDurSum = 0L @@ -65,6 +82,9 @@ let runSimulation (days: int64) (seed: uint64) : int = let mutable sleepDay = 0L let mutable nightTicks = 0L let mutable dayTicks = 0L + let npcTotal = Array.create npcCount 0L + let lastActions = Array.create npcCount (world.Npcs.[0]).Mind.Action + let mutable chatsWindowStart = 0L while t < totalTicks do let d, input = if t < driver.Until then driver, driver.Input @@ -76,7 +96,12 @@ let runSimulation (days: int64) (seed: uint64) : int = t <- t + 1L let nightNow = Sim.isNightTick t if nightNow then nightTicks <- nightTicks + 1L else dayTicks <- dayTicks + 1L - let head = List.head world.Npcs + for npc in world.Npcs do + let idx = npcIndex npc.Id + if npc.Mind.Action = Chat && lastActions.[idx] <> Chat then + npcTotal.[idx] <- npcTotal.[idx] + 1L + lastActions.[idx] <- npc.Mind.Action + let head = world.Npcs.[0] if head.Mind.Action = Sleep then if nightNow then sleepNight <- sleepNight + 1L else sleepDay <- sleepDay + 1L if head.Mind.Action <> lastAction then @@ -88,27 +113,18 @@ let runSimulation (days: int64) (seed: uint64) : int = if Single.IsNaN p.X || Single.IsNaN p.Y || Single.IsInfinity p.X || Single.IsInfinity p.Y then nonFinite <- nonFinite + 1L if p.X < 0.0f || p.X > maxX || p.Y < 0.0f || p.Y > maxY then outOfBounds <- outOfBounds + 1L - if t % 2000L = 0L then - let day = float t / float ticksPerDay - let memTotal = GC.GetTotalMemory(true) - for npc in world.Npcs do - let n = npc.Mind.Needs - let p' = npc.Pos - let memCount = List.length npc.Mind.Memory - let lastValence = - match List.tryHead npc.Mind.Memory with - | Some e -> e.Valence - | None -> 0.0f - printfn "npc=%A tick=%d day=%.4f pos=(%.1f,%.1f) hunger=%.2f energy=%.2f social=%.2f money=%.2f action=%s mem_count=%d last_valence=%.2f" - npc.Id t day p'.X p'.Y n.Hunger n.Energy n.Social n.Money (actionName npc.Mind.Action) memCount lastValence - if t % 1000L = 0L && t % 2000L <> 0L then + if t % summaryInterval = 0L then + let eat, sleep, wander, work, chat = actionDistribution world.Npcs + let chatsTotal = Array.sum npcTotal let day = float t / float ticksPerDay - printfn "tick=%d time=%.4fs day=%.4f pos=(%.1f,%.1f) rng=%016x" t world.Time day p.X p.Y world.Rng.State + printfn "summary tick=%d day=%.4f eat=%d sleep=%d wander=%d work=%d chat=%d chats_window=%d" + t day eat sleep wander work chat (chatsTotal - chatsWindowStart) + chatsWindowStart <- chatsTotal let segments = switchCount + 1L let avgActionTicks = float (switchDurSum + (totalTicks - lastStart)) / float segments let nightPct = if nightTicks > 0L then 100.0 * float sleepNight / float nightTicks else 0.0 let dayPct = if dayTicks > 0L then 100.0 * float sleepDay / float dayTicks else 0.0 - let npc0 = List.head world.Npcs + let npc0 = world.Npcs.[0] let memCount = List.length npc0.Mind.Memory let lastValence = match List.tryHead npc0.Mind.Memory with @@ -116,31 +132,40 @@ let runSimulation (days: int64) (seed: uint64) : int = | None -> 0.0f printfn "npc=%A action_switches=%d avg_action_ticks=%.1f sleep_night_ticks=%d sleep_day_ticks=%d sleep_night_pct=%.2f sleep_day_pct=%.2f mem_count=%d last_valence=%.2f" npc0.Id switchCount avgActionTicks sleepNight sleepDay nightPct dayPct memCount lastValence + let chatsTotal = Array.sum npcTotal + let minChats = if npcCount > 0 then Array.min npcTotal else 0L + let maxChats = if npcCount > 0 then Array.max npcTotal else 0L + let avgChats = if npcCount > 0 then float chatsTotal / float npcCount else 0.0 + printfn "chats_total=%d chats_min=%d chats_max=%d chats_avg=%.2f" chatsTotal minChats maxChats avgChats printfn "done tick=%d non-finite=%d out-of-bounds=%d" world.Tick nonFinite outOfBounds if nonFinite > 0L || outOfBounds > 0L then 1 else 0 [<EntryPoint>] let main argv = - let rec parse (i: int) (days: int64 option) (seed: uint64 option) : Result<int64 * uint64, string> = + let rec parse (i: int) (days: int64 option) (seed: uint64 option) (npc: int option) : Result<int64 * uint64 * int, string> = if i >= argv.Length then - match days, seed with - | Some d, Some s -> Ok(d, s) + match days, seed, npc with + | Some d, Some s, Some n -> Ok(d, s, n) | _ -> Error "missing --days/--seed" else match argv.[i] with | "--days" when i + 1 < argv.Length -> (match Int64.TryParse argv.[i + 1] with - | true, d when d > 0L -> parse (i + 2) (Some d) seed + | true, d when d > 0L -> parse (i + 2) (Some d) seed npc | _ -> Error $"invalid --days '{argv.[i + 1]}'") | "--seed" when i + 1 < argv.Length -> (match UInt64.TryParse argv.[i + 1] with - | true, s -> parse (i + 2) days (Some s) + | true, s -> parse (i + 2) days (Some s) npc | _ -> Error $"invalid --seed '{argv.[i + 1]}'") + | "--npc" when i + 1 < argv.Length -> + (match Int32.TryParse argv.[i + 1] with + | true, n when n > 0 && n <= 1000 -> parse (i + 2) days seed (Some n) + | _ -> Error $"invalid --npc '{argv.[i + 1]}'") | other -> Error $"unknown argument '{other}'" - match parse 0 None None with - | Ok(days, seed) -> runSimulation days seed + match parse 0 None None (Some 30) with + | Ok(days, seed, npc) -> runSimulation days seed npc | Error msg -> eprintfn $"headless: {msg}" - eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S" + eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S [--npc N]" 2 diff --git a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs index 0e1766e..972ce19 100644 --- a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs +++ b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs @@ -153,12 +153,12 @@ type DeterminismTests () = [<TestMethod>] member _.NpcNeedsDecayOverTimeAndActionsDifferAcrossSeeds () = let w0 = Sim.initialWorld 42UL - let npc0 = List.exactlyOne w0.Npcs + let npc0 = w0.Npcs |> Array.exactlyOne let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } } let mutable w = w0 for _ in 1 .. 500 do w <- Sim.step zero w - let npc1 = List.exactlyOne w.Npcs + let npc1 = w.Npcs |> Array.exactlyOne let n0 = npc0.Mind.Needs let n1 = npc1.Mind.Needs Assert.IsTrue(n1.Hunger < n0.Hunger, "hunger must decay") @@ -241,3 +241,59 @@ type DeterminismTests () = | None -> () Assert.IsTrue(sawEmpty, "memory must start empty") Assert.IsTrue(sawEvent, "expected a valence memory event within 6000 ticks") + + [<TestMethod>] + member _.Npc30SameSeedTracesAreTickByTickEqualAndEventsDrain () = + let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } } + let mutable a = Sim.initialWorldN 42UL 30 + let mutable b = Sim.initialWorldN 42UL 30 + for t in 1L .. 30000L do + a <- Sim.step zero a + b <- Sim.step zero b + if a <> b then Assert.Fail($"30-npc worlds diverged at tick {t}") + if not a.Events.IsEmpty then Assert.Fail($"Events queue not drained at tick {t}") + Assert.IsTrue(30000L = a.Tick) + + [<TestMethod>] + member _.Npc30ChatsRecordSymmetricPositiveMemories () = + let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } } + let mutable w = Sim.initialWorldN 42UL 30 + let mutable prev0 = w.Npcs.[0].Mind.Action + let mutable symmetryChecked = false + let mutable chatObserved = 0 + let total = 600000L + for _ in 1L .. total do + w <- Sim.step zero w + for npc in w.Npcs do + if npc.Mind.Action = Chat then chatObserved <- chatObserved + 1 + let npc0 = w.Npcs.[0] + if not symmetryChecked && npc0.Mind.Action = Chat && prev0 <> Chat then + match List.tryHead npc0.Mind.Memory with + | Some entry -> + match entry.Kind with + | Chatted partner -> + if partner = npc0.Id then Assert.Fail("chat partner must differ from self") + let partnerNpc = w.Npcs |> Array.find (fun n -> n.Id = partner) + let partnerAlsoChatted = + partnerNpc.Mind.Memory + |> List.exists (fun e -> match e.Kind with Chatted p -> p = npc0.Id | _ -> false) + if not partnerAlsoChatted then + Assert.Fail("chat memory must be recorded symmetrically for both partners") + symmetryChecked <- true + | _ -> Assert.Fail($"chat start must record a Chatted memory, got {entry.Kind}") + | None -> Assert.Fail("chat start must record a Chatted memory") + prev0 <- npc0.Mind.Action + Assert.IsTrue(symmetryChecked, "expected npc0 to start at least one chat within the run") + Assert.IsTrue(chatObserved > 0, "expected some NPC to be chatting during the run") + let mutable chattedMemories = 0 + for npc in w.Npcs do + Assert.IsTrue(npc.Mind.Memory.Length <= Sim.memoryCapacity, "memory exceeds ring capacity") + for e in npc.Mind.Memory do + match e.Kind with + | Chatted partner -> + chattedMemories <- chattedMemories + 1 + if partner = npc.Id then Assert.Fail("chat partner must differ from self") + if e.Valence <> Sim.chatValence then + Assert.Fail($"chat valence must be {Sim.chatValence}, got {e.Valence}") + | _ -> () + Assert.IsTrue(chattedMemories > 0, "expected Chatted memories after the run") diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs index 6ba48e2..62ce1e1 100644 --- a/src/LivingVillage.Kernel/Sim.fs +++ b/src/LivingVillage.Kernel/Sim.fs @@ -46,18 +46,27 @@ module Sim = | Sleep | Wander | Work + | Chat type MemoryKind = | Meal | Rest | Pay | Hungry + | Chatted of NpcId type MemoryEvent = { Tick: int64 Kind: MemoryKind Valence: float32 } + type InteractionKind = + | ChatInit of NpcId * NpcId + + type InteractionEvent = + { Tick: int64 + Kind: InteractionKind } + [<Struct>] type Mind = { Needs: Needs @@ -82,7 +91,8 @@ module Sim = Rng: RngState Avatar: Avatar NoHost: NoHost - Npcs: Npc list } + Npcs: Npc[] + Events: InteractionEvent list } let ticksPerSecond = 60L let secondsPerDay = 86400L @@ -102,8 +112,14 @@ module Sim = let minActionTicks = 600L let urgentThreshold = 20.0f let nightSleepMultiplier = 3.0f + let npcCount = 30 + let chatRangePx = 96.0f + let chatRangeSq = chatRangePx * chatRangePx + let chatTicks = 300L + let chatSocialRestore = 40.0f + let chatValence = 0.3f - let clamp v lo hi = if v < lo then lo elif v > hi then hi else v + let clamp (v: float32) (lo: float32) (hi: float32) : float32 = if v < lo then lo elif v > hi then hi else v let hungerDecayPerTick = 0.0012f let energyDecayPerTick = 0.0010f @@ -125,6 +141,7 @@ module Sim = | Sleep -> homePoint | Wander -> plazaPoint | Work -> worksitePoint + | Chat -> plazaPoint let isNightTick (tick: int64) : bool = let hourTicks = ticksPerDay / 24L @@ -137,6 +154,7 @@ module Sim = | Rest -> 0.4f | Pay -> 0.2f | Hungry -> -0.4f + | Chatted _ -> chatValence let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem @@ -148,6 +166,7 @@ module Sim = | Sleep -> Some Rest | Work -> Some Pay | Wander -> None + | Chat -> None let personalityOfSeed (seed: uint64) : Personality = let a, r1 = Rng.nextFloat32 (Rng.ofSeed seed) @@ -174,6 +193,7 @@ module Sim = | Sleep -> (100.0f - needs.Energy) * (0.25f + 2.0f * (1.0f - p.Drive)) | Wander -> (100.0f - needs.Social) * (0.25f + 2.0f * p.Extraversion) | Work -> (100.0f - needs.Money) * (0.25f + 2.0f * p.Greed) + | Chat -> 0.0f if kind = Sleep && night then raw * nightSleepMultiplier else raw let decideAction (night: bool) (needs: Needs) (p: Personality) : NpcActionKind = @@ -192,16 +212,17 @@ module Sim = | Sleep -> { n with Energy = n.Energy + 60.0f } | Wander -> { n with Social = n.Social + 15.0f; Hunger = n.Hunger - 2.0f } | Work -> { n with Money = n.Money + 20.0f; Energy = n.Energy - 10.0f } + | Chat -> { n with Social = n.Social + chatSocialRestore } |> needsClamp - let private moveToward (pos: Vec2) (target: Vec2) (maxStep: float32) : Vec2 * bool = + let private moveToward (pos: Vec2) (target: Vec2) (maxStep: float32) : struct (Vec2 * bool) = let dx = target.X - pos.X let dy = target.Y - pos.Y let len = sqrt (dx * dx + dy * dy) - if len <= maxStep + arriveEpsilon then target, true + if len <= maxStep + arriveEpsilon then struct (target, true) else let inv = maxStep / len - { X = pos.X + dx * inv; Y = pos.Y + dy * inv }, false + struct ({ X = pos.X + dx * inv; Y = pos.Y + dy * inv }, false) let initialWorld (seed: uint64) : World = let centerX = float32 (mapWidthTiles * tilePixels / 2 - tilePixels / 2) @@ -226,9 +247,53 @@ module Sim = Rng = Rng.ofSeed seed Avatar = { Pos = { X = centerX; Y = centerY } } NoHost = { Reserved = 0UL } - Npcs = [ npc ] } + Npcs = [| npc |] + Events = [] } - let private stepNpc (tick: int64) (npc: Npc) : Npc = + let initialWorldN (seed: uint64) (count: int) : World = + let base_ = initialWorld seed + let cols = 6 + let spacing = 64.0f + let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f } + let npcs = + Array.init count (fun i -> + let col = i % cols + let row = i / cols + let pos = + { X = plazaPoint.X + (float32 col - 2.5f) * spacing + Y = plazaPoint.Y + (float32 row - 2.0f) * spacing } + let personality = personalityOfSeed (seed + uint64 i * 0x9E3779B97F4A7C15UL) + let startAction = decideAction (isNightTick 0L) needs personality + { Id = NpcId i + Pos = pos + Mind = + { Needs = needs + Personality = personality + Action = startAction + Target = actionTarget startAction + ActionAge = 0L + EffectDone = false + HungerFlagged = false + Memory = [] } }) + { base_ with Npcs = npcs } + + let chatableForChat (n: Npc) : bool = + n.Mind.Action <> Sleep && n.Mind.Action <> Chat + + let findChatPartner (self: NpcId) (pos: Vec2) (npcs: Npc[]) : NpcId option = + let mutable best = None + let mutable bestD2 = chatRangeSq + for o in npcs do + if o.Id <> self && chatableForChat o then + let dx = o.Pos.X - pos.X + let dy = o.Pos.Y - pos.Y + let d2 = dx * dx + dy * dy + if d2 < bestD2 then + bestD2 <- d2 + best <- Some o.Id + best + + let private stepNpc (tick: int64) (npcs: Npc[]) (pending: ResizeArray<InteractionEvent>) (npc: Npc) : Npc = let decayed = needsClamp { Hunger = npc.Mind.Needs.Hunger - hungerDecayPerTick @@ -238,8 +303,7 @@ module Sim = let night = isNightTick tick let age = npc.Mind.ActionAge + 1L let urgent = needsUrgent decayed - let target = actionTarget npc.Mind.Action - let nextPos, arrived = moveToward npc.Pos target (npcSpeed * dtSecondsF) + let maxStep = npcSpeed * dtSecondsF let mind0 = { npc.Mind with Needs = decayed @@ -250,46 +314,92 @@ module Sim = if decayed.Hunger < urgentThreshold && not npc.Mind.HungerFlagged then { mind0 with Memory = recordMemory tick Hungry mind0.Memory; HungerFlagged = true } else mind0 - if arrived then - let needs2, mem2 = - if mind1.EffectDone then mind1.Needs, mind1.Memory - else - let mem = - match actionMemoryKind mind1.Action with - | Some k -> recordMemory tick k mind1.Memory - | None -> mind1.Memory - applyActionEffect mind1.Action mind1.Needs, mem - let mind2 = { mind1 with Needs = needs2; Memory = mem2; EffectDone = true } - if age >= minActionTicks || urgent then - let action = decideAction night needs2 mind2.Personality - if action = mind2.Action then - { npc with Pos = nextPos; Mind = { mind2 with ActionAge = 0L; EffectDone = false } } - else - { npc with - Pos = nextPos - Mind = - { mind2 with - Action = action - Target = actionTarget action - ActionAge = 0L - EffectDone = false } } + let switchTo (resetOnSame: bool) (mind: Mind) (needsNow: Needs) (pos: Vec2) : Npc = + let action = decideAction night needsNow mind.Personality + if action = Wander then + match findChatPartner npc.Id pos npcs with + | Some partner -> + pending.Add { Tick = tick; Kind = ChatInit(npc.Id, partner) } + { npc with Pos = pos; Mind = mind } + | None -> + if action = mind.Action then + if resetOnSame then + { npc with Pos = pos; Mind = { mind with ActionAge = 0L; EffectDone = false } } + else { npc with Pos = pos; Mind = mind } + else + { npc with + Pos = pos + Mind = { mind with Action = action; Target = actionTarget action; ActionAge = 0L; EffectDone = false } } + elif action = mind.Action then + if resetOnSame then + { npc with Pos = pos; Mind = { mind with ActionAge = 0L; EffectDone = false } } + else { npc with Pos = pos; Mind = mind } + else + { npc with + Pos = pos + Mind = { mind with Action = action; Target = actionTarget action; ActionAge = 0L; EffectDone = false } } + if mind1.Action = Chat then + let struct (nextPos, _) = moveToward npc.Pos mind1.Target maxStep + if age >= chatTicks then + let needs2 = applyActionEffect Chat mind1.Needs + switchTo true { mind1 with Needs = needs2 } needs2 nextPos else - { npc with Pos = nextPos; Mind = mind2 } - elif urgent && age < minActionTicks then - let action = decideAction night decayed mind1.Personality - if action = mind1.Action then { npc with Pos = nextPos; Mind = mind1 } + else + let target = actionTarget npc.Mind.Action + let struct (nextPos, arrived) = moveToward npc.Pos target maxStep + if arrived then + let needs2, mem2 = + if mind1.EffectDone then mind1.Needs, mind1.Memory + else + let mem = + match actionMemoryKind mind1.Action with + | Some k -> recordMemory tick k mind1.Memory + | None -> mind1.Memory + applyActionEffect mind1.Action mind1.Needs, mem + let mind2 = { mind1 with Needs = needs2; Memory = mem2; EffectDone = true } + if age >= minActionTicks || urgent then + switchTo true mind2 needs2 nextPos + else + { npc with Pos = nextPos; Mind = mind2 } + elif urgent && age < minActionTicks then + switchTo false mind1 decayed nextPos else - { npc with - Pos = nextPos - Mind = - { mind1 with - Action = action - Target = actionTarget action - ActionAge = 0L - EffectDone = false } } + { npc with Pos = nextPos; Mind = mind1 } + + let private applyChatInit (tick: int64) (a: NpcId) (b: NpcId) (npcs: Npc[]) : Npc[] = + if a = b then npcs else - { npc with Pos = nextPos; Mind = mind1 } + let mutable ia = -1 + let mutable ib = -1 + for i in 0 .. npcs.Length - 1 do + let id = npcs.[i].Id + if id = a then ia <- i elif id = b then ib <- i + if ia < 0 || ib < 0 then npcs + else + let na = npcs.[ia] + let nb = npcs.[ib] + if chatableForChat na && chatableForChat nb && ia <> ib then + npcs.[ia] <- + { na with + Mind = + { na.Mind with + Action = Chat + Target = nb.Pos + ActionAge = 0L + EffectDone = false + Memory = recordMemory tick (Chatted b) na.Mind.Memory } } + npcs.[ib] <- + { nb with + Mind = + { nb.Mind with + Action = Chat + Target = na.Pos + ActionAge = 0L + EffectDone = false + Memory = recordMemory tick (Chatted a) nb.Mind.Memory } } + npcs + else npcs let step (ts: TimeStep) (world: World) : World = let tick = world.Tick + 1L @@ -299,6 +409,16 @@ module Sim = let dy = ts.Input.MoveY * avatarSpeed * dtSecondsF let rngOut, rngNext = Rng.nextUInt64 world.Rng ignore rngOut + let pending = ResizeArray<InteractionEvent> () + let oldNpcs = world.Npcs + let newNpcs = Array.copy oldNpcs + for i in 0 .. newNpcs.Length - 1 do + newNpcs.[i] <- stepNpc tick oldNpcs pending newNpcs.[i] + let queue = if pending.Count = 0 then world.Events else world.Events @ List.ofSeq pending + if queue.Length > 0 then + for ev in queue do + match ev.Kind with + | ChatInit (a, b) -> applyChatInit ev.Tick a b newNpcs |> ignore { Tick = tick Time = float tick * dtSeconds Rng = rngNext @@ -307,4 +427,5 @@ module Sim = { X = clamp (world.Avatar.Pos.X + dx) 0.0f maxX Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY } } NoHost = world.NoHost - Npcs = world.Npcs |> List.map (stepNpc tick) } + Npcs = newNpcs + Events = [] } |