diff options
Diffstat (limited to 'src/LivingVillage.Kernel')
| -rw-r--r-- | src/LivingVillage.Kernel/Sim.fs | 449 |
1 files changed, 373 insertions, 76 deletions
diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs index 5fb56fd..0845abd 100644 --- a/src/LivingVillage.Kernel/Sim.fs +++ b/src/LivingVillage.Kernel/Sim.fs @@ -7,10 +7,6 @@ module Sim = { X: float32 Y: float32 } - [<Struct>] - type Avatar = - { Pos: Vec2 } - type Input = { MoveX: float32 MoveY: float32 } @@ -55,6 +51,33 @@ module Sim = type RumorId = | RumorId of int64 + type DialogueIntent = + | SmallTalk + | AskHelp + | OfferTrade + | Joke + | Apologize + | Provoke + + type DialogueResponse = + | Friendly + | Helpful + | Bargaining + | Amused + | Forgiving + | Hostile + | Reserved + | Refused + | Offended + + type DialogueOutcome = + { Tick: int64 + Actor: NpcId + Target: NpcId + Intent: DialogueIntent + Response: DialogueResponse + Valence: float32 } + type MemoryKind = | Meal | Rest @@ -64,6 +87,7 @@ module Sim = | Rumor of RumorId | Bought of NpcId * ItemKind * int * float32 | Sold of NpcId * ItemKind * int * float32 + | Dialogue of NpcId * DialogueIntent * DialogueResponse type RumorEvent = { Id: RumorId @@ -84,11 +108,51 @@ module Sim = type InteractionKind = | ChatInit of NpcId * NpcId | TradeEvent of NpcId * NpcId * ItemKind * int * float32 + | DialogueEvent of DialogueOutcome type InteractionEvent = { Tick: int64 Kind: InteractionKind } + type NeedKind = + | HungerNeed + | EnergyNeed + | SocialNeed + | MoneyNeed + + type NeedScore = + { Kind: NeedKind + Urgency: float32 } + + type NeedsPanel = + { Needs: Needs + Ranked: NeedScore list } + + type VisibleBounds = + { Min: Vec2 + Max: Vec2 } + + type Observation = + { Id: NpcId + Pos: Vec2 + Needs: Needs + Ranked: NeedScore list + RecentMemory: MemoryEvent list } + + type DialogueMenu = + { Target: NpcId + Options: DialogueIntent list } + + type AnnalKind = + | DialogueAnnal of DialogueOutcome + | RumorAnnal of RumorEvent + | TradeAnnal of InteractionEvent + + type AnnalEntry = + { Tick: int64 + Kind: AnnalKind + Summary: string } + [<Struct>] type Mind = { Needs: Needs @@ -101,6 +165,11 @@ module Sim = Memory: MemoryEvent list } [<Struct>] + type Avatar = + { Pos: Vec2 + Mind: Mind } + + [<Struct>] type Npc = { Id: NpcId Pos: Vec2 @@ -116,7 +185,17 @@ module Sim = NoHost: NoHost Npcs: Npc[] Events: InteractionEvent list - Rumors: RumorEvent list } + Rumors: RumorEvent list + Annals: AnnalEntry list } + + type DialogueFailure = + | DialogueTargetNotFound + | DialogueTargetOutOfRange + | DialogueTargetUnavailable + + type DialogueResult = + | DialogueSucceeded of DialogueOutcome * World + | DialogueRejected of DialogueFailure * World type ChatRequest = { Narrator: NpcId @@ -182,8 +261,15 @@ module Sim = let relationHalfLifeTicks = ticksPerDay // HALF_LIFE = 1 模拟日（修复单位错误：原 86400L 实为 24 模拟分钟；1 模拟日 = ticksPerDay = 5,184,000 tick） let relationThreshold = 0.5f // |rel| > 0.5 视为有关系 + let playerId = NpcId -1 + let dialogueOptions = [ SmallTalk; AskHelp; OfferTrade; Joke; Apologize; Provoke ] + let maxAnnalEntries = 128 + let clamp (v: float32) (lo: float32) (hi: float32) : float32 = if v < lo then lo elif v > hi then hi else v + let private appendAnnal (entry: AnnalEntry) (world: World) : World = + { world with Annals = (entry :: world.Annals) |> List.truncate maxAnnalEntries } + let hungerDecayPerTick = 0.0012f let energyDecayPerTick = 0.0010f let socialDecayPerTick = 0.0008f @@ -221,12 +307,24 @@ module Sim = | Rumor _ -> 0.1f | Bought _ -> 0.3f | Sold _ -> 0.3f + | Dialogue (_, _, response) -> + match response with + | Friendly -> 0.4f + | Helpful -> 0.5f + | Bargaining -> 0.2f + | Amused -> 0.35f + | Forgiving -> 0.45f + | Hostile -> -0.5f + | Reserved -> 0.0f + | Refused -> -0.1f + | Offended -> -0.4f let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list = let updated = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem let isRelational (event: MemoryEvent) = match event.Kind with - | Chatted _ -> true + | Chatted _ + | Dialogue _ -> true | _ -> false let relationalCount = updated |> List.sumBy (fun event -> if isRelational event then 1 else 0) let relationalCapacity = min memoryCapacity relationalCount @@ -288,6 +386,18 @@ module Sim = || n.Social < urgentThreshold || n.Money < urgentThreshold + let private rankNeeds (n: Needs) : NeedScore list = + [ { Kind = HungerNeed; Urgency = clamp (100.0f - n.Hunger) 0.0f 100.0f } + { Kind = EnergyNeed; Urgency = clamp (100.0f - n.Energy) 0.0f 100.0f } + { Kind = SocialNeed; Urgency = clamp (100.0f - n.Social) 0.0f 100.0f } + { Kind = MoneyNeed; Urgency = clamp (100.0f - n.Money) 0.0f 100.0f } ] + |> List.sortByDescending (fun score -> score.Urgency) + + let needsPanel (world: World) : NeedsPanel = + let needs = world.Avatar.Mind.Needs + { Needs = needs + Ranked = rankNeeds needs } + let applyActionEffect (kind: NpcActionKind) (n: Needs) : Needs = match kind with | Eat -> { n with Hunger = n.Hunger + 40.0f; Money = n.Money - 5.0f } @@ -326,14 +436,26 @@ module Sim = EffectDone = false HungerFlagged = false Memory = [] } } + let avatar = + { Pos = { X = centerX; Y = centerY } + Mind = + { Needs = needs + Personality = personality + Action = Wander + Target = { X = centerX; Y = centerY } + ActionAge = 0L + EffectDone = false + HungerFlagged = false + Memory = [] } } { Tick = 0L Time = 0.0 Rng = Rng.ofSeed seed - Avatar = { Pos = { X = centerX; Y = centerY } } + Avatar = avatar NoHost = { Reserved = 0UL } Npcs = [| npc |] Events = [] - Rumors = [] } + Rumors = [] + Annals = [] } let initialWorldN (seed: uint64) (count: int) : World = let base_ = initialWorld seed @@ -465,7 +587,13 @@ module Sim = let event = { Tick = world.Tick Kind = TradeEvent(request.Buyer, request.Seller, request.Item, request.Quantity, unitPrice) } - TradeSucceeded { world with Npcs = newNpcs; Events = world.Events @ [ event ] } + let updated = { world with Npcs = newNpcs; Events = world.Events @ [ event ] } + let entry = + { Tick = world.Tick + Kind = TradeAnnal event + Summary = sprintf "trade tick=%d buyer=%A seller=%A item=%A quantity=%d price=%.2f" + world.Tick request.Buyer request.Seller request.Item request.Quantity unitPrice } + TradeSucceeded(appendAnnal entry updated) let chatableForChat (n: Npc) : bool = n.Mind.Action <> Sleep && n.Mind.Action <> Chat @@ -520,6 +648,123 @@ module Sim = max current id) -1L RumorId(maxId + 1L) + let private dialogueAvailable (npc: Npc) : bool = + npc.Mind.Action <> Sleep && npc.Mind.Action <> Chat + + let openDialogueMenu (world: World) : DialogueMenu option = + let nearby = + world.Npcs + |> Array.choose (fun npc -> + let dx = npc.Pos.X - world.Avatar.Pos.X + let dy = npc.Pos.Y - world.Avatar.Pos.Y + let distanceSq = dx * dx + dy * dy + if distanceSq <= chatRangeSq && dialogueAvailable npc then + Some(distanceSq, npc.Id) + else None) + |> Array.sortBy fst + nearby + |> Array.tryHead + |> Option.map (fun (_, target) -> + { Target = target + Options = dialogueOptions }) + + let private responseFor (intent: DialogueIntent) (personality: Personality) : DialogueResponse = + match intent with + | SmallTalk -> if personality.Extraversion >= 0.5f then Friendly else Reserved + | AskHelp -> if personality.Honesty >= 0.4f then Helpful else Refused + | OfferTrade -> Bargaining + | Joke -> if personality.Extraversion >= 0.5f then Amused else Reserved + | Apologize -> if personality.Aggression < 0.7f then Forgiving else Offended + | Provoke -> if personality.Aggression >= 0.5f then Hostile else Offended + + let private dialogueSummary (outcome: DialogueOutcome) : string = + sprintf "dialogue tick=%d actor=%A target=%A intent=%A response=%A valence=%.2f" + outcome.Tick outcome.Actor outcome.Target outcome.Intent outcome.Response outcome.Valence + + let private rumorSummary (rumor: RumorEvent) : string = + sprintf "rumor tick=%d source=%A narrator=%A receiver=%A depth=%d" + rumor.Tick rumor.Source rumor.Narrator rumor.Receiver rumor.Depth + + let chooseDialogue (target: NpcId) (intent: DialogueIntent) (world: World) : DialogueResult = + match findNpcIndex target world.Npcs with + | None -> DialogueRejected(DialogueTargetNotFound, world) + | Some targetIndex -> + let targetNpc = world.Npcs.[targetIndex] + let dx = targetNpc.Pos.X - world.Avatar.Pos.X + let dy = targetNpc.Pos.Y - world.Avatar.Pos.Y + if dx * dx + dy * dy > chatRangeSq then + DialogueRejected(DialogueTargetOutOfRange, world) + elif not (dialogueAvailable targetNpc) then + DialogueRejected(DialogueTargetUnavailable, world) + else + let response = responseFor intent targetNpc.Mind.Personality + let outcome = + { Tick = world.Tick + Actor = playerId + Target = target + Intent = intent + Response = response + Valence = valenceOfKind (Dialogue(target, intent, response)) } + let rumor = + { Id = nextRumorId world + Tick = world.Tick + OriginTick = world.Tick + Source = playerId + Narrator = playerId + Receiver = target + Parent = None + Depth = 0 + Strength = 1.0f } + let newNpcs = Array.copy world.Npcs + let targetMemory = + recordMemory world.Tick (Dialogue(playerId, intent, response)) targetNpc.Mind.Memory + |> recordMemory world.Tick (Rumor rumor.Id) + newNpcs.[targetIndex] <- { targetNpc with Mind = { targetNpc.Mind with Memory = targetMemory } } + let avatarMemory = recordMemory world.Tick (Dialogue(target, intent, response)) world.Avatar.Mind.Memory + let event = { Tick = world.Tick; Kind = DialogueEvent outcome } + let updated = + { world with + Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = avatarMemory } } + Npcs = newNpcs + Events = world.Events @ [ event ] + Rumors = rumor :: world.Rumors } + let withRumorAnnal = + appendAnnal + { Tick = world.Tick + Kind = RumorAnnal rumor + Summary = rumorSummary rumor } + updated + let withDialogueAnnal = + appendAnnal + { Tick = world.Tick + Kind = DialogueAnnal outcome + Summary = dialogueSummary outcome } + withRumorAnnal + DialogueSucceeded(outcome, withDialogueAnnal) + + let annalText (world: World) : string = + let rows = + world.Annals + |> List.rev + |> List.map (fun entry -> sprintf "tick=%d %s" entry.Tick entry.Summary) + String.concat "\n" (sprintf "chronicle count=%d" world.Annals.Length :: rows) + + let observeVisible (bounds: VisibleBounds) (world: World) : Observation list = + let inside (pos: Vec2) = + pos.X >= bounds.Min.X + && pos.X <= bounds.Max.X + && pos.Y >= bounds.Min.Y + && pos.Y <= bounds.Max.Y + world.Npcs + |> Array.toList + |> List.filter (fun npc -> inside npc.Pos) + |> List.map (fun npc -> + { Id = npc.Id + Pos = npc.Pos + Needs = npc.Mind.Needs + Ranked = rankNeeds npc.Mind.Needs + RecentMemory = List.truncate 8 npc.Mind.Memory }) + let private rumorIsDuplicate (request: ChatRequest) (parent: RumorEvent option) (world: World) : bool = let parentId = parent |> Option.map (fun rumor -> rumor.Id) world.Rumors @@ -531,74 +776,107 @@ module Sim = && world.Tick - rumor.Tick <= rumorFreshnessTicks && rumorStrengthAt world.Tick rumor >= rumorMinimumStrength) + type private ChatParticipant = + | AvatarParticipant + | NpcParticipant of int + + let private findChatParticipant (id: NpcId) (world: World) : ChatParticipant option = + if id = playerId then + Some AvatarParticipant + else + findNpcIndex id world.Npcs |> Option.map NpcParticipant + + let private participantPosition (participant: ChatParticipant) (world: World) : Vec2 = + match participant with + | AvatarParticipant -> world.Avatar.Pos + | NpcParticipant index -> world.Npcs.[index].Pos + + let private participantChatable (participant: ChatParticipant) (world: World) : bool = + match participant with + | AvatarParticipant -> true + | NpcParticipant index -> chatableForChat world.Npcs.[index] + + let private markChat (participant: ChatParticipant) (other: NpcId) (otherPos: Vec2) (world: World) : World = + match participant with + | AvatarParticipant -> + let memory = recordMemory world.Tick (Chatted other) world.Avatar.Mind.Memory + { world with Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = memory } } } + | NpcParticipant index -> + let newNpcs = Array.copy world.Npcs + let npc = newNpcs.[index] + let memory = recordMemory world.Tick (Chatted other) npc.Mind.Memory + newNpcs.[index] <- + { npc with + Mind = + { npc.Mind with + Action = Chat + Target = otherPos + ActionAge = 0L + EffectDone = false + Memory = memory } } + { world with Npcs = newNpcs } + let chat (request: ChatRequest) (world: World) : ChatResult = - match findNpcIndex request.Narrator world.Npcs with - | None -> ChatRejected(NarratorNotFound, world) - | Some narratorIndex when request.Narrator = request.Receiver -> ChatRejected(ChatSameParticipant, world) - | Some narratorIndex -> - match findNpcIndex request.Receiver world.Npcs with - | None -> ChatRejected(ReceiverNotFound, world) - | Some receiverIndex -> - let narrator = world.Npcs.[narratorIndex] - let receiver = world.Npcs.[receiverIndex] - if not (chatableForChat narrator) || not (chatableForChat receiver) then - ChatRejected(ParticipantNotChatable, world) + match findChatParticipant request.Narrator world, findChatParticipant request.Receiver world with + | None, _ -> ChatRejected(NarratorNotFound, world) + | _, None -> ChatRejected(ReceiverNotFound, world) + | Some _, Some _ when request.Narrator = request.Receiver -> ChatRejected(ChatSameParticipant, world) + | Some narrator, Some receiver -> + if not (participantChatable narrator world) || not (participantChatable receiver world) then + ChatRejected(ParticipantNotChatable, world) + else + let parent = latestRumorFor request.Narrator world + let narratorPos = participantPosition narrator world + let receiverPos = participantPosition receiver world + let chatted = + world + |> markChat narrator request.Receiver receiverPos + |> markChat receiver request.Narrator narratorPos + if rumorIsDuplicate request parent world then + ChatSucceeded(None, chatted) else - let parent = latestRumorFor request.Narrator world - let newNpcs = Array.copy world.Npcs - let narratorMemory = recordMemory world.Tick (Chatted request.Receiver) narrator.Mind.Memory - let receiverMemory = recordMemory world.Tick (Chatted request.Narrator) receiver.Mind.Memory - newNpcs.[narratorIndex] <- - { narrator with - Mind = - { narrator.Mind with - Action = Chat - Target = receiver.Pos - ActionAge = 0L - EffectDone = false - Memory = narratorMemory } } - newNpcs.[receiverIndex] <- - { receiver with - Mind = - { receiver.Mind with - Action = Chat - Target = narrator.Pos - ActionAge = 0L - EffectDone = false - Memory = receiverMemory } } - let chatted = { world with Npcs = newNpcs } - if rumorIsDuplicate request parent world then - ChatSucceeded(None, chatted) - else - let rumor = - match parent with - | None -> - { Id = nextRumorId world - Tick = world.Tick - OriginTick = world.Tick - Source = request.Narrator - Narrator = request.Narrator - Receiver = request.Receiver - Parent = None - Depth = 0 - Strength = 1.0f } - | Some parent -> - { Id = nextRumorId world - Tick = world.Tick - OriginTick = parent.OriginTick - Source = parent.Source - Narrator = request.Narrator - Receiver = request.Receiver - Parent = Some parent.Id - Depth = parent.Depth + 1 - Strength = rumorStrengthAt world.Tick parent } - let receiverWithRumor = - { newNpcs.[receiverIndex] with - Mind = - { newNpcs.[receiverIndex].Mind with - Memory = recordMemory world.Tick (Rumor rumor.Id) newNpcs.[receiverIndex].Mind.Memory } } - newNpcs.[receiverIndex] <- receiverWithRumor - ChatSucceeded(Some rumor, { chatted with Npcs = newNpcs; Rumors = rumor :: world.Rumors }) + let rumor = + match parent with + | None -> + { Id = nextRumorId world + Tick = world.Tick + OriginTick = world.Tick + Source = request.Narrator + Narrator = request.Narrator + Receiver = request.Receiver + Parent = None + Depth = 0 + Strength = 1.0f } + | Some parent -> + { Id = nextRumorId world + Tick = world.Tick + OriginTick = parent.OriginTick + Source = parent.Source + Narrator = request.Narrator + Receiver = request.Receiver + Parent = Some parent.Id + Depth = parent.Depth + 1 + Strength = rumorStrengthAt world.Tick parent } + let withReceiverRumor = + match receiver with + | AvatarParticipant -> + let memory = recordMemory world.Tick (Rumor rumor.Id) chatted.Avatar.Mind.Memory + { chatted with Avatar = { chatted.Avatar with Mind = { chatted.Avatar.Mind with Memory = memory } } } + | NpcParticipant index -> + let newNpcs = Array.copy chatted.Npcs + let npc = newNpcs.[index] + newNpcs.[index] <- + { npc with + Mind = { npc.Mind with Memory = recordMemory world.Tick (Rumor rumor.Id) npc.Mind.Memory } } + { chatted with Npcs = newNpcs } + let updated = { withReceiverRumor with Rumors = rumor :: world.Rumors } + ChatSucceeded( + Some rumor, + appendAnnal + { Tick = world.Tick + Kind = RumorAnnal rumor + Summary = rumorSummary rumor } + updated) let rumorPath (world: World) (target: RumorId) : RumorEvent list = let rec collect (visited: Set<RumorId>) (current: RumorId) (acc: RumorEvent list) = @@ -729,6 +1007,23 @@ module Sim = 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 + let avatarNeeds = + needsClamp + { Hunger = world.Avatar.Mind.Needs.Hunger - hungerDecayPerTick + Energy = world.Avatar.Mind.Needs.Energy - energyDecayPerTick + Social = world.Avatar.Mind.Needs.Social - socialDecayPerTick + Money = world.Avatar.Mind.Needs.Money - moneyDecayPerTick } + let avatarMemory, avatarFlagged = + if avatarNeeds.Hunger < urgentThreshold && not world.Avatar.Mind.HungerFlagged then + (recordMemory tick Hungry world.Avatar.Mind.Memory), true + else + world.Avatar.Mind.Memory, avatarNeeds.Hunger < urgentThreshold + let avatarMind = + { world.Avatar.Mind with + Needs = avatarNeeds + ActionAge = world.Avatar.Mind.ActionAge + 1L + HungerFlagged = avatarFlagged + Memory = avatarMemory } let baseWorld = { world with Tick = tick @@ -737,7 +1032,8 @@ module Sim = Avatar = { Pos = { X = clamp (world.Avatar.Pos.X + dx) 0.0f maxX - Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY } } + Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY } + Mind = avatarMind } Npcs = newNpcs } let mutable nextWorld = baseWorld for ev in queue do @@ -747,6 +1043,7 @@ module Sim = | ChatSucceeded (_, updated) -> nextWorld <- updated | ChatRejected (_, _) -> () | TradeEvent _ -> () + | DialogueEvent _ -> () { nextWorld with Events = [] } // ---- 关系网派生：rel(i,j) = sum(Chatted valence * exp(-ln2*(now-tick)/HALF_LIFE))（真半衰：age=HALF_LIFE 处权重恰 0.5）---- |