path: root/src/LivingVillage.Kernel/Sim.fs

namespace LivingVillage.Kernel

module Sim =

    [<Struct>]
    type Vec2 =
        { X: float32
          Y: float32 }

    [<Struct>]
    type Avatar =
        { Pos: Vec2 }

    type Input =
        { MoveX: float32
          MoveY: float32 }

    type TimeStep =
        { Input: Input }

    [<Struct>]
    type NoHost =
        { Reserved: uint64 }

    [<Struct>]
    type NpcId =
        | NpcId of int

    [<Struct>]
    type Needs =
        { Hunger: float32
          Energy: float32
          Social: float32
          Money: float32 }

    [<Struct>]
    type Personality =
        { Drive: float32
          Aggression: float32
          Extraversion: float32
          Honesty: float32
          Greed: float32 }

    type NpcActionKind =
        | Eat
        | Sleep
        | Wander
        | Work

    [<Struct>]
    type Mind =
        { Needs: Needs
          Personality: Personality
          Action: NpcActionKind
          Target: Vec2 }

    [<Struct>]
    type Npc =
        { Id: NpcId
          Pos: Vec2
          Mind: Mind }

    [<Struct>]
    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 }