namespace LivingVillage.Kernel module Sim = [] type Vec2 = { X: float32 Y: float32 } [] type Avatar = { Pos: Vec2 } type Input = { MoveX: float32 MoveY: float32 } type TimeStep = { Input: Input } [] type NoHost = { Reserved: uint64 } [] type NpcId = | NpcId of int [] type Needs = { Hunger: float32 Energy: float32 Social: float32 Money: float32 } [] type Personality = { Drive: float32 Aggression: float32 Extraversion: float32 Honesty: float32 Greed: float32 } type NpcActionKind = | Eat | Sleep | Wander | Work type MemoryKind = | Meal | Rest | Pay | Hungry type MemoryEvent = { Tick: int64 Kind: MemoryKind Valence: float32 } [] type Mind = { Needs: Needs Personality: Personality Action: NpcActionKind Target: Vec2 ActionAge: int64 EffectDone: bool HungerFlagged: bool Memory: MemoryEvent list } [] type Npc = { Id: NpcId Pos: Vec2 Mind: Mind } [] type World = { Tick: int64 Time: float Rng: RngState Avatar: Avatar NoHost: NoHost Npcs: Npc list } let ticksPerSecond = 60L let secondsPerDay = 86400L let ticksPerDay = secondsPerDay * ticksPerSecond let dtSeconds = 1.0 / float ticksPerSecond let dtSecondsF = 1.0f / float32 ticksPerSecond let mapWidthTiles = 64 let mapHeightTiles = 48 let tilePixels = 32 let avatarSpeed = 160.0f let npcSpeed = 80.0f let arriveEpsilon = 2.0f let memoryCapacity = 64 let minActionTicks = 600L let urgentThreshold = 20.0f let nightSleepMultiplier = 3.0f let clamp v lo hi = if v < lo then lo elif v > hi then hi else v let hungerDecayPerTick = 0.0012f let energyDecayPerTick = 0.0010f let socialDecayPerTick = 0.0008f let moneyDecayPerTick = 0.0006f let private tileCenter (tx: int) (ty: int) : Vec2 = { X = float32 (tx * tilePixels + tilePixels / 2) Y = float32 (ty * tilePixels + tilePixels / 2) } let kitchenPoint = tileCenter 10 10 let homePoint = tileCenter 52 10 let plazaPoint = tileCenter 32 24 let worksitePoint = tileCenter 52 38 let actionTarget (kind: NpcActionKind) : Vec2 = match kind with | Eat -> kitchenPoint | Sleep -> homePoint | Wander -> plazaPoint | Work -> worksitePoint let isNightTick (tick: int64) : bool = let hourTicks = ticksPerDay / 24L let tod = tick % ticksPerDay tod >= 22L * hourTicks || tod < 6L * hourTicks let valenceOfKind (kind: MemoryKind) : float32 = match kind with | Meal -> 0.5f | Rest -> 0.4f | Pay -> 0.2f | Hungry -> -0.4f let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem |> List.truncate memoryCapacity let actionMemoryKind (kind: NpcActionKind) : MemoryKind option = match kind with | Eat -> Some Meal | Sleep -> Some Rest | Work -> Some Pay | Wander -> None let personalityOfSeed (seed: uint64) : Personality = let a, r1 = Rng.nextFloat32 (Rng.ofSeed seed) let b, r2 = Rng.nextFloat32 r1 let c, r3 = Rng.nextFloat32 r2 let d, r4 = Rng.nextFloat32 r3 let e, _ = Rng.nextFloat32 r4 { Drive = a Aggression = b Extraversion = c Honesty = d Greed = e } let needsClamp (n: Needs) : Needs = { Hunger = clamp n.Hunger 0.0f 100.0f Energy = clamp n.Energy 0.0f 100.0f Social = clamp n.Social 0.0f 100.0f Money = clamp n.Money 0.0f 100.0f } let scoreAction (night: bool) (needs: Needs) (p: Personality) (kind: NpcActionKind) : float32 = let raw = match kind with | Eat -> (100.0f - needs.Hunger) * (0.25f + 2.0f * p.Drive) | 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) if kind = Sleep && night then raw * nightSleepMultiplier else raw let decideAction (night: bool) (needs: Needs) (p: Personality) : NpcActionKind = let candidates = [ Eat; Sleep; Wander; Work ] candidates |> List.maxBy (scoreAction night needs p) let needsUrgent (n: Needs) : bool = n.Hunger < urgentThreshold || n.Energy < urgentThreshold || n.Social < urgentThreshold || n.Money < urgentThreshold let applyActionEffect (kind: NpcActionKind) (n: Needs) : Needs = match kind with | Eat -> { n with Hunger = n.Hunger + 40.0f; Money = n.Money - 5.0f } | 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 } |> needsClamp let private moveToward (pos: Vec2) (target: Vec2) (maxStep: float32) : 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 else let inv = maxStep / len { X = pos.X + dx * inv; Y = pos.Y + dy * inv }, false let initialWorld (seed: uint64) : World = let centerX = float32 (mapWidthTiles * tilePixels / 2 - tilePixels / 2) let centerY = float32 (mapHeightTiles * tilePixels / 2 - tilePixels / 2) let personality = personalityOfSeed seed let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f } let startAction = decideAction (isNightTick 0L) needs personality let npc = { Id = NpcId 0 Pos = { X = centerX; Y = centerY } Mind = { Needs = needs Personality = personality Action = startAction Target = actionTarget startAction ActionAge = 0L EffectDone = false HungerFlagged = false Memory = [] } } { Tick = 0L Time = 0.0 Rng = Rng.ofSeed seed Avatar = { Pos = { X = centerX; Y = centerY } } NoHost = { Reserved = 0UL } Npcs = [ npc ] } let private stepNpc (tick: int64) (npc: Npc) : Npc = let decayed = needsClamp { Hunger = npc.Mind.Needs.Hunger - hungerDecayPerTick Energy = npc.Mind.Needs.Energy - energyDecayPerTick Social = npc.Mind.Needs.Social - socialDecayPerTick Money = npc.Mind.Needs.Money - moneyDecayPerTick } 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 mind0 = { npc.Mind with Needs = decayed ActionAge = age HungerFlagged = if decayed.Hunger < urgentThreshold then npc.Mind.HungerFlagged else false } let mind1 = 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 } } 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 { npc with Pos = nextPos Mind = { mind1 with Action = action Target = actionTarget action ActionAge = 0L EffectDone = false } } else { npc with Pos = nextPos; Mind = mind1 } let step (ts: TimeStep) (world: World) : World = let tick = world.Tick + 1L let maxX = float32 (mapWidthTiles * tilePixels - tilePixels) let maxY = float32 (mapHeightTiles * tilePixels - tilePixels) let dx = ts.Input.MoveX * avatarSpeed * dtSecondsF let dy = ts.Input.MoveY * avatarSpeed * dtSecondsF let rngOut, rngNext = Rng.nextUInt64 world.Rng ignore rngOut { Tick = tick Time = float tick * dtSeconds Rng = rngNext Avatar = { Pos = { 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) }