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
        | 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
          Personality: Personality
          Action: NpcActionKind
          Target: Vec2
          ActionAge: int64
          EffectDone: bool
          HungerFlagged: bool
          Memory: MemoryEvent list }

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

    [<Struct>]
    type World =
        { Tick: int64
          Time: float
          Rng: RngState
          Avatar: Avatar
          NoHost: NoHost
          Npcs: Npc[]
          Events: InteractionEvent 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 npcCount = 30
    let chatRangePx = 96.0f
    let chatRangeSq = chatRangePx * chatRangePx
    let chatTicks = 300L
    let chatSocialRestore = 40.0f
    let chatValence = 0.3f

    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
    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
        | Chat -> plazaPoint

    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
        | Chatted _ -> chatValence

    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
        | Chat -> 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)
            | Chat -> 0.0f
        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 }
        | Chat -> { n with Social = n.Social + chatSocialRestore }
        |> needsClamp

    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 struct (target, true)
        else
            let inv = maxStep / len
            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)
        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 |]
          Events = [] }

    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
                  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 maxStep = 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
        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 = 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 }

    let private applyChatInit (tick: int64) (a: NpcId) (b: NpcId) (npcs: Npc[]) : Npc[] =
        if a = b then npcs
        else
            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
        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
        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
          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 = newNpcs
          Events = [] }