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) (value: string) = tokens.Add(value) let private addInt (tokens: ResizeArray) (value: int) = add tokens (value.ToString(invariant)) let private addInt64 (tokens: ResizeArray) (value: int64) = add tokens (value.ToString(invariant)) let private addUInt64 (tokens: ResizeArray) (value: uint64) = add tokens (value.ToString(invariant)) let private addFloat (tokens: ResizeArray) (value: float) = add tokens (value.ToString("R", invariant)) let private addFloat32 (tokens: ResizeArray) (value: float32) = add tokens (value.ToString("R", invariant)) let private addBool (tokens: ResizeArray) (value: bool) = add tokens (if value then "1" else "0") let private addText (tokens: ResizeArray) (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 when not (Double.IsNaN(value) || Double.IsInfinity(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 when not (Single.IsNaN(value) || Single.IsInfinity(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) = 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) if quantity < 0 then invalid (sprintf "invalid %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() 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 = 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 = try File.ReadAllText(path) |> load with | :? IOException as ex -> Error(sprintf "could not read save: %s" ex.Message)