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 Mind = { Needs: Needs Personality: Personality Action: NpcActionKind Target: Vec2 } [] 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 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 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 (needs: Needs) (p: Personality) (kind: NpcActionKind) : float32 = 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) let decideAction (needs: Needs) (p: Personality) : NpcActionKind = let candidates = [ Eat; Sleep; Wander; Work ] candidates |> List.maxBy (scoreAction needs p) 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 needs personality let npc = { Id = NpcId 0 Pos = { X = centerX; Y = centerY } Mind = { Needs = needs; Personality = personality; Action = startAction; Target = actionTarget startAction } } { Tick = 0L Time = 0.0 Rng = Rng.ofSeed seed Avatar = { Pos = { X = centerX; Y = centerY } } NoHost = { Reserved = 0UL } Npcs = [ npc ] } let private stepNpc (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 mind0 = { npc.Mind with Needs = decayed } let target = actionTarget mind0.Action let nextPos, arrived = moveToward npc.Pos target (npcSpeed * dtSecondsF) if arrived then let needs = applyActionEffect mind0.Action mind0.Needs let action = decideAction needs mind0.Personality { npc with Pos = target; Mind = { Needs = needs; Personality = mind0.Personality; Action = action; Target = actionTarget action } } else { npc with Pos = nextPos; Mind = mind0 } 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 }