summaryrefslogtreecommitdiff
path: root/src/LivingVillage.Kernel
diff options
context:
space:
mode:
Diffstat (limited to 'src/LivingVillage.Kernel')
-rw-r--r--src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj2
-rw-r--r--src/LivingVillage.Kernel/SimulationControl.fs54
-rw-r--r--src/LivingVillage.Kernel/WorldSave.fs533
3 files changed, 589 insertions, 0 deletions
diff --git a/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj b/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
index 8a4fad1..2a3126c 100644
--- a/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
+++ b/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
@@ -7,6 +7,8 @@
<ItemGroup>
<Compile Include="Rng.fs" />
<Compile Include="Sim.fs" />
+ <Compile Include="SimulationControl.fs" />
+ <Compile Include="WorldSave.fs" />
</ItemGroup>
</Project>
diff --git a/src/LivingVillage.Kernel/SimulationControl.fs b/src/LivingVillage.Kernel/SimulationControl.fs
new file mode 100644
index 0000000..83e5f36
--- /dev/null
+++ b/src/LivingVillage.Kernel/SimulationControl.fs
@@ -0,0 +1,54 @@
+namespace LivingVillage.Kernel
+
+type SimulationSpeed =
+ | OneX
+ | TwoX
+ | FiveX
+
+type SimulationControl =
+ { Paused: bool
+ Speed: SimulationSpeed }
+
+module SimulationControl =
+
+ let initial : SimulationControl =
+ { Paused = false
+ Speed = OneX }
+
+ let setSpeed (speed: SimulationSpeed) (control: SimulationControl) : SimulationControl =
+ { control with Speed = speed }
+
+ let togglePause (control: SimulationControl) : SimulationControl =
+ { control with Paused = not control.Paused }
+
+ let initialForConfiguredSteps (configuredSteps: int) : SimulationControl * int option =
+ let steps = if configuredSteps > 0 then configuredSteps else 1
+ let control =
+ match steps with
+ | 2 -> setSpeed TwoX initial
+ | 5 -> setSpeed FiveX initial
+ | _ -> initial
+ let legacySteps =
+ match steps with
+ | 1
+ | 2
+ | 5 -> None
+ | value -> Some value
+ control, legacySteps
+
+ let stepsPerFrame (control: SimulationControl) : int =
+ if control.Paused then
+ 0
+ else
+ match control.Speed with
+ | OneX -> 1
+ | TwoX -> 2
+ | FiveX -> 5
+
+ let stepsPerFrameWithLegacy (legacySteps: int option) (control: SimulationControl) : int =
+ if control.Paused then
+ 0
+ else
+ match legacySteps with
+ | Some steps when steps > 0 -> steps
+ | _ -> stepsPerFrame control
diff --git a/src/LivingVillage.Kernel/WorldSave.fs b/src/LivingVillage.Kernel/WorldSave.fs
new file mode 100644
index 0000000..726170b
--- /dev/null
+++ b/src/LivingVillage.Kernel/WorldSave.fs
@@ -0,0 +1,533 @@
+namespace LivingVillage.Kernel
+
+open System
+open System.Globalization
+open System.IO
+open System.Text
+open LivingVillage.Kernel.Sim
+
+module WorldSave =
+
+ let private invariant = CultureInfo.InvariantCulture
+ let private formatVersion = "LV_WORLD_SAVE_V1"
+
+ exception private SaveParseError of string
+
+ type private TokenReader(tokens: string[]) =
+ let mutable index = 0
+
+ member _.Take(label: string) =
+ if index >= tokens.Length then
+ raise (SaveParseError(sprintf "missing %s" label))
+ let value = tokens.[index]
+ index <- index + 1
+ value
+
+ member _.Remaining = tokens.Length - index
+
+ let private invalid message = raise (SaveParseError message)
+
+ let private add (tokens: ResizeArray<string>) (value: string) = tokens.Add(value)
+
+ let private addInt (tokens: ResizeArray<string>) (value: int) =
+ add tokens (value.ToString(invariant))
+
+ let private addInt64 (tokens: ResizeArray<string>) (value: int64) =
+ add tokens (value.ToString(invariant))
+
+ let private addUInt64 (tokens: ResizeArray<string>) (value: uint64) =
+ add tokens (value.ToString(invariant))
+
+ let private addFloat (tokens: ResizeArray<string>) (value: float) =
+ add tokens (value.ToString("R", invariant))
+
+ let private addFloat32 (tokens: ResizeArray<string>) (value: float32) =
+ add tokens (value.ToString("R", invariant))
+
+ let private addBool (tokens: ResizeArray<string>) (value: bool) =
+ add tokens (if value then "1" else "0")
+
+ let private addText (tokens: ResizeArray<string>) (value: string) =
+ let safeValue = if isNull value then "" else value
+ add tokens (Convert.ToBase64String(Encoding.UTF8.GetBytes(safeValue)))
+
+ let private readInt (reader: TokenReader) label =
+ let token = reader.Take(label)
+ match Int32.TryParse(token, NumberStyles.Integer, invariant) with
+ | true, value -> value
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readInt64 (reader: TokenReader) label =
+ let token = reader.Take(label)
+ match Int64.TryParse(token, NumberStyles.Integer, invariant) with
+ | true, value -> value
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readUInt64 (reader: TokenReader) label =
+ let token = reader.Take(label)
+ match UInt64.TryParse(token, NumberStyles.Integer, invariant) with
+ | true, value -> value
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readFloat (reader: TokenReader) label =
+ let token = reader.Take(label)
+ match Double.TryParse(token, NumberStyles.Float, invariant) with
+ | true, value -> value
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readFloat32 (reader: TokenReader) label =
+ let token = reader.Take(label)
+ match Single.TryParse(token, NumberStyles.Float, invariant) with
+ | true, value -> value
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readBool (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "0" -> false
+ | "1" -> true
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private readText (reader: TokenReader) label =
+ let token = reader.Take(label)
+ try
+ Encoding.UTF8.GetString(Convert.FromBase64String(token))
+ with
+ | :? FormatException -> invalid (sprintf "invalid %s" label)
+
+ let private readCount (reader: TokenReader) label =
+ let count = readInt reader label
+ if count < 0 || count > 1000000 then
+ invalid (sprintf "invalid %s count" label)
+ count
+
+ let private writeNpcId tokens (NpcId id) = addInt tokens id
+
+ let private readNpcId (reader: TokenReader) label =
+ NpcId(readInt reader label)
+
+ let private writeRumorId tokens (RumorId id) = addInt64 tokens id
+
+ let private readRumorId (reader: TokenReader) label =
+ RumorId(readInt64 reader label)
+
+ let private writeItemKind tokens item =
+ match item with
+ | Food -> add tokens "food"
+
+ let private readItemKind (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "food" -> Food
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeActionKind tokens action =
+ match action with
+ | Eat -> add tokens "eat"
+ | Sleep -> add tokens "sleep"
+ | Wander -> add tokens "wander"
+ | Work -> add tokens "work"
+ | Chat -> add tokens "chat"
+
+ let private readActionKind (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "eat" -> Eat
+ | "sleep" -> Sleep
+ | "wander" -> Wander
+ | "work" -> Work
+ | "chat" -> Chat
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeIntent tokens intent =
+ match intent with
+ | SmallTalk -> add tokens "small-talk"
+ | AskHelp -> add tokens "ask-help"
+ | OfferTrade -> add tokens "offer-trade"
+ | Joke -> add tokens "joke"
+ | Apologize -> add tokens "apologize"
+ | Provoke -> add tokens "provoke"
+
+ let private readIntent (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "small-talk" -> SmallTalk
+ | "ask-help" -> AskHelp
+ | "offer-trade" -> OfferTrade
+ | "joke" -> Joke
+ | "apologize" -> Apologize
+ | "provoke" -> Provoke
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeResponse tokens response =
+ match response with
+ | Friendly -> add tokens "friendly"
+ | Helpful -> add tokens "helpful"
+ | Bargaining -> add tokens "bargaining"
+ | Amused -> add tokens "amused"
+ | Forgiving -> add tokens "forgiving"
+ | Hostile -> add tokens "hostile"
+ | Reserved -> add tokens "reserved"
+ | Refused -> add tokens "refused"
+ | Offended -> add tokens "offended"
+
+ let private readResponse (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "friendly" -> Friendly
+ | "helpful" -> Helpful
+ | "bargaining" -> Bargaining
+ | "amused" -> Amused
+ | "forgiving" -> Forgiving
+ | "hostile" -> Hostile
+ | "reserved" -> Reserved
+ | "refused" -> Refused
+ | "offended" -> Offended
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeVec2 tokens (value: Vec2) =
+ addFloat32 tokens value.X
+ addFloat32 tokens value.Y
+
+ let private readVec2 reader label =
+ { X = readFloat32 reader (label + ".x")
+ Y = readFloat32 reader (label + ".y") }
+
+ let private writeNeeds tokens (value: Needs) =
+ addFloat32 tokens value.Hunger
+ addFloat32 tokens value.Energy
+ addFloat32 tokens value.Social
+ addFloat32 tokens value.Money
+
+ let private readNeeds reader label =
+ { Hunger = readFloat32 reader (label + ".hunger")
+ Energy = readFloat32 reader (label + ".energy")
+ Social = readFloat32 reader (label + ".social")
+ Money = readFloat32 reader (label + ".money") }
+
+ let private writePersonality tokens (value: Personality) =
+ addFloat32 tokens value.Drive
+ addFloat32 tokens value.Aggression
+ addFloat32 tokens value.Extraversion
+ addFloat32 tokens value.Honesty
+ addFloat32 tokens value.Greed
+
+ let private readPersonality reader label =
+ { Drive = readFloat32 reader (label + ".drive")
+ Aggression = readFloat32 reader (label + ".aggression")
+ Extraversion = readFloat32 reader (label + ".extraversion")
+ Honesty = readFloat32 reader (label + ".honesty")
+ Greed = readFloat32 reader (label + ".greed") }
+
+ let private writeDialogueOutcome tokens (value: DialogueOutcome) =
+ addInt64 tokens value.Tick
+ writeNpcId tokens value.Actor
+ writeNpcId tokens value.Target
+ writeIntent tokens value.Intent
+ writeResponse tokens value.Response
+ addFloat32 tokens value.Valence
+
+ let private readDialogueOutcome reader label =
+ { Tick = readInt64 reader (label + ".tick")
+ Actor = readNpcId reader (label + ".actor")
+ Target = readNpcId reader (label + ".target")
+ Intent = readIntent reader (label + ".intent")
+ Response = readResponse reader (label + ".response")
+ Valence = readFloat32 reader (label + ".valence") }
+
+ let private writeRumor tokens (value: RumorEvent) =
+ writeRumorId tokens value.Id
+ addInt64 tokens value.Tick
+ addInt64 tokens value.OriginTick
+ writeNpcId tokens value.Source
+ writeNpcId tokens value.Narrator
+ writeNpcId tokens value.Receiver
+ match value.Parent with
+ | None -> add tokens "none"
+ | Some parent ->
+ add tokens "some"
+ writeRumorId tokens parent
+ addInt tokens value.Depth
+ addFloat32 tokens value.Strength
+
+ let private readRumor (reader: TokenReader) label =
+ let id = readRumorId reader (label + ".id")
+ let tick = readInt64 reader (label + ".tick")
+ let originTick = readInt64 reader (label + ".origin-tick")
+ let source = readNpcId reader (label + ".source")
+ let narrator = readNpcId reader (label + ".narrator")
+ let receiver = readNpcId reader (label + ".receiver")
+ let parent =
+ match reader.Take(label + ".parent") with
+ | "none" -> None
+ | "some" -> Some(readRumorId reader (label + ".parent-id"))
+ | _ -> invalid (sprintf "invalid %s parent" label)
+ { Id = id
+ Tick = tick
+ OriginTick = originTick
+ Source = source
+ Narrator = narrator
+ Receiver = receiver
+ Parent = parent
+ Depth = readInt reader (label + ".depth")
+ Strength = readFloat32 reader (label + ".strength") }
+
+ let private writeMemoryKind tokens kind =
+ match kind with
+ | Meal -> add tokens "meal"
+ | Rest -> add tokens "rest"
+ | Pay -> add tokens "pay"
+ | Hungry -> add tokens "hungry"
+ | Chatted partner ->
+ add tokens "chatted"
+ writeNpcId tokens partner
+ | Rumor rumor ->
+ add tokens "rumor"
+ writeRumorId tokens rumor
+ | Bought (partner, item, quantity, price) ->
+ add tokens "bought"
+ writeNpcId tokens partner
+ writeItemKind tokens item
+ addInt tokens quantity
+ addFloat32 tokens price
+ | Sold (partner, item, quantity, price) ->
+ add tokens "sold"
+ writeNpcId tokens partner
+ writeItemKind tokens item
+ addInt tokens quantity
+ addFloat32 tokens price
+ | Dialogue (target, intent, response) ->
+ add tokens "dialogue"
+ writeNpcId tokens target
+ writeIntent tokens intent
+ writeResponse tokens response
+
+ let private readMemoryKind (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "meal" -> Meal
+ | "rest" -> Rest
+ | "pay" -> Pay
+ | "hungry" -> Hungry
+ | "chatted" -> Chatted(readNpcId reader (label + ".partner"))
+ | "rumor" -> Rumor(readRumorId reader (label + ".id"))
+ | "bought" ->
+ Bought(
+ readNpcId reader (label + ".partner"),
+ readItemKind reader (label + ".item"),
+ readInt reader (label + ".quantity"),
+ readFloat32 reader (label + ".price"))
+ | "sold" ->
+ Sold(
+ readNpcId reader (label + ".partner"),
+ readItemKind reader (label + ".item"),
+ readInt reader (label + ".quantity"),
+ readFloat32 reader (label + ".price"))
+ | "dialogue" ->
+ Dialogue(
+ readNpcId reader (label + ".target"),
+ readIntent reader (label + ".intent"),
+ readResponse reader (label + ".response"))
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeMemoryEvent tokens (value: MemoryEvent) =
+ addInt64 tokens value.Tick
+ writeMemoryKind tokens value.Kind
+ addFloat32 tokens value.Valence
+
+ let private readMemoryEvent reader label =
+ { Tick = readInt64 reader (label + ".tick")
+ Kind = readMemoryKind reader (label + ".kind")
+ Valence = readFloat32 reader (label + ".valence") }
+
+ let private writeInteractionKind tokens kind =
+ match kind with
+ | ChatInit (narrator, receiver) ->
+ add tokens "chat-init"
+ writeNpcId tokens narrator
+ writeNpcId tokens receiver
+ | TradeEvent (buyer, seller, item, quantity, price) ->
+ add tokens "trade-event"
+ writeNpcId tokens buyer
+ writeNpcId tokens seller
+ writeItemKind tokens item
+ addInt tokens quantity
+ addFloat32 tokens price
+ | DialogueEvent outcome ->
+ add tokens "dialogue-event"
+ writeDialogueOutcome tokens outcome
+
+ let private readInteractionKind (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "chat-init" -> ChatInit(readNpcId reader (label + ".narrator"), readNpcId reader (label + ".receiver"))
+ | "trade-event" ->
+ TradeEvent(
+ readNpcId reader (label + ".buyer"),
+ readNpcId reader (label + ".seller"),
+ readItemKind reader (label + ".item"),
+ readInt reader (label + ".quantity"),
+ readFloat32 reader (label + ".price"))
+ | "dialogue-event" -> DialogueEvent(readDialogueOutcome reader (label + ".outcome"))
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeInteraction tokens (value: InteractionEvent) =
+ addInt64 tokens value.Tick
+ writeInteractionKind tokens value.Kind
+
+ let private readInteraction reader label =
+ { Tick = readInt64 reader (label + ".tick")
+ Kind = readInteractionKind reader (label + ".kind") }
+
+ let private writeAnnalKind tokens kind =
+ match kind with
+ | DialogueAnnal outcome ->
+ add tokens "dialogue"
+ writeDialogueOutcome tokens outcome
+ | RumorAnnal rumor ->
+ add tokens "rumor"
+ writeRumor tokens rumor
+ | TradeAnnal event ->
+ add tokens "trade"
+ writeInteraction tokens event
+
+ let private readAnnalKind (reader: TokenReader) label =
+ match reader.Take(label) with
+ | "dialogue" -> DialogueAnnal(readDialogueOutcome reader (label + ".outcome"))
+ | "rumor" -> RumorAnnal(readRumor reader (label + ".rumor"))
+ | "trade" -> TradeAnnal(readInteraction reader (label + ".event"))
+ | _ -> invalid (sprintf "invalid %s" label)
+
+ let private writeAnnal tokens (value: AnnalEntry) =
+ addInt64 tokens value.Tick
+ writeAnnalKind tokens value.Kind
+ addText tokens value.Summary
+
+ let private readAnnal reader label =
+ { Tick = readInt64 reader (label + ".tick")
+ Kind = readAnnalKind reader (label + ".kind")
+ Summary = readText reader (label + ".summary") }
+
+ let private writeMind tokens (value: Mind) =
+ writeNeeds tokens value.Needs
+ writePersonality tokens value.Personality
+ writeActionKind tokens value.Action
+ writeVec2 tokens value.Target
+ addInt64 tokens value.ActionAge
+ addBool tokens value.EffectDone
+ addBool tokens value.HungerFlagged
+ addInt tokens value.Memory.Length
+ value.Memory |> List.iter (writeMemoryEvent tokens)
+
+ let private readMind reader label =
+ let needs = readNeeds reader (label + ".needs")
+ let personality = readPersonality reader (label + ".personality")
+ let action = readActionKind reader (label + ".action")
+ let target = readVec2 reader (label + ".target")
+ let actionAge = readInt64 reader (label + ".action-age")
+ let effectDone = readBool reader (label + ".effect-done")
+ let hungerFlagged = readBool reader (label + ".hunger-flagged")
+ let memoryCount = readCount reader (label + ".memory")
+ { Needs = needs
+ Personality = personality
+ Action = action
+ Target = target
+ ActionAge = actionAge
+ EffectDone = effectDone
+ HungerFlagged = hungerFlagged
+ Memory = List.init memoryCount (fun index -> readMemoryEvent reader (sprintf "%s.memory[%d]" label index)) }
+
+ let private writeAvatar tokens (value: Avatar) =
+ writeVec2 tokens value.Pos
+ writeMind tokens value.Mind
+
+ let private readAvatar reader =
+ { Pos = readVec2 reader "avatar.pos"
+ Mind = readMind reader "avatar.mind" }
+
+ let private writeInventory tokens (inventory: Map<ItemKind, int>) =
+ let entries = inventory |> Map.toList |> List.sortBy (fun (item, _) -> sprintf "%A" item)
+ addInt tokens entries.Length
+ for item, quantity in entries do
+ writeItemKind tokens item
+ addInt tokens quantity
+
+ let private readInventory reader label =
+ let count = readCount reader (label + ".count")
+ [ for index in 0 .. count - 1 do
+ let item = readItemKind reader (sprintf "%s[%d].item" label index)
+ let quantity = readInt reader (sprintf "%s[%d].quantity" label index)
+ yield item, quantity ]
+ |> Map.ofList
+
+ let private writeNpc tokens (value: Npc) =
+ writeNpcId tokens value.Id
+ writeVec2 tokens value.Pos
+ writeInventory tokens value.Inventory
+ writeMind tokens value.Mind
+
+ let private readNpc reader index =
+ { Id = readNpcId reader (sprintf "npc[%d].id" index)
+ Pos = readVec2 reader (sprintf "npc[%d].pos" index)
+ Inventory = readInventory reader (sprintf "npc[%d].inventory" index)
+ Mind = readMind reader (sprintf "npc[%d].mind" index) }
+
+ let save (world: World) : string =
+ let tokens = ResizeArray<string>()
+ add tokens formatVersion
+ addInt64 tokens world.Tick
+ addFloat tokens world.Time
+ addUInt64 tokens world.Rng.State
+ addUInt64 tokens world.NoHost.Reserved
+ writeAvatar tokens world.Avatar
+ addInt tokens world.Npcs.Length
+ world.Npcs |> Array.iter (writeNpc tokens)
+ addInt tokens world.Events.Length
+ world.Events |> List.iter (writeInteraction tokens)
+ addInt tokens world.Rumors.Length
+ world.Rumors |> List.iter (writeRumor tokens)
+ addInt tokens world.Annals.Length
+ world.Annals |> List.iter (writeAnnal tokens)
+ String.Join("|", tokens)
+
+ let load (text: string) : Result<World, string> =
+ if isNull text then
+ Error "save text is null"
+ else
+ try
+ let tokens = text.Split([| '|' |], StringSplitOptions.None)
+ let reader = TokenReader(tokens)
+ if reader.Take("format") <> formatVersion then
+ invalid "unsupported save format"
+ let tick = readInt64 reader "tick"
+ let time = readFloat reader "time"
+ let rng = { State = readUInt64 reader "rng" }
+ let noHost = { Reserved = readUInt64 reader "no-host" }
+ let avatar = readAvatar reader
+ let npcCount = readCount reader "npcs"
+ let npcs = Array.init npcCount (fun index -> readNpc reader index)
+ let eventCount = readCount reader "events"
+ let events = List.init eventCount (fun index -> readInteraction reader (sprintf "event[%d]" index))
+ let rumorCount = readCount reader "rumors"
+ let rumors = List.init rumorCount (fun index -> readRumor reader (sprintf "rumor[%d]" index))
+ let annalCount = readCount reader "annals"
+ let annals = List.init annalCount (fun index -> readAnnal reader (sprintf "annal[%d]" index))
+ if reader.Remaining <> 0 then
+ invalid "trailing save data"
+ Ok
+ { Tick = tick
+ Time = time
+ Rng = rng
+ Avatar = avatar
+ NoHost = noHost
+ Npcs = npcs
+ Events = events
+ Rumors = rumors
+ Annals = annals }
+ with
+ | SaveParseError message -> Error message
+ | :? FormatException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+ | :? OverflowException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+ | :? ArgumentException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+
+ let saveToFile (path: string) (world: World) : unit =
+ File.WriteAllText(path, save world, UTF8Encoding(false))
+
+ let loadFromFile (path: string) : Result<World, string> =
+ try
+ File.ReadAllText(path) |> load
+ with
+ | :? IOException as ex -> Error(sprintf "could not read save: %s" ex.Message)
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 19:43:41 +0000