1 files changed, 97 insertions, 0 deletions
diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs
new file mode 100644
index 0000000..ea8b1b0
--- /dev/null
+++ b/src/LivingVillage.Headless/Program.fs
@@ -0,0 +1,97 @@
+module Program
+
+open System
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+
+let ticksPerSecond = 60L
+let secondsPerDay = 86400L
+let ticksPerDay = secondsPerDay * ticksPerSecond
+
+let segmentTicks = 900L
+
+let zeroInput = { MoveX = 0.0f; MoveY = 0.0f }
+
+type Driver =
+    { Rng: RngState
+      Until: int64
+      Input: Input }
+
+let nextSegment (rng: RngState) (until: int64) : Driver =
+    let a, r1 = Rng.nextUInt64 rng
+    let m, r2 = Rng.nextUInt64 r1
+    let diag = 0.70710678f
+    let dirX, dirY =
+        match int (a &&& 7UL) with
+        | 0 -> 1.0f, 0.0f
+        | 1 -> diag, diag
+        | 2 -> 0.0f, 1.0f
+        | 3 -> -diag, diag
+        | 4 -> -1.0f, 0.0f
+        | 5 -> -diag, -diag
+        | 6 -> 0.0f, -1.0f
+        | _ -> diag, -diag
+    let mag =
+        match int (m % 3UL) with
+        | 0 -> 0.4f
+        | 1 -> 0.7f
+        | _ -> 1.0f
+    { Rng = r2
+      Until = until + segmentTicks
+      Input = { MoveX = dirX * mag; MoveY = dirY * mag } }
+
+let runSimulation (days: int64) (seed: uint64) : int =
+    let totalTicks = days * ticksPerDay
+    printfn "living-village headless days=%d seed=%d ticks=%d tickrate=%d" days seed totalTicks ticksPerSecond
+    let mutable world = Sim.initialWorld seed
+    let mutable driver = { Rng = Rng.ofSeed seed; Until = segmentTicks; Input = zeroInput }
+    let maxX = float32 (Sim.mapWidthTiles * Sim.tilePixels - Sim.tilePixels)
+    let maxY = float32 (Sim.mapHeightTiles * Sim.tilePixels - Sim.tilePixels)
+    let mutable nonFinite = 0L
+    let mutable outOfBounds = 0L
+    let mutable t = 0L
+    while t < totalTicks do
+        let d, input =
+            if t < driver.Until then driver, driver.Input
+            else
+                let d = nextSegment driver.Rng driver.Until
+                d, d.Input
+        driver <- d
+        world <- Sim.step { Input = input } world
+        t <- t + 1L
+        let p = world.Avatar.Pos
+        if Single.IsNaN p.X || Single.IsNaN p.Y || Single.IsInfinity p.X || Single.IsInfinity p.Y then
+            nonFinite <- nonFinite + 1L
+        if p.X < 0.0f || p.X > maxX || p.Y < 0.0f || p.Y > maxY then outOfBounds <- outOfBounds + 1L
+        if t % 1000L = 0L then
+            let mem = GC.GetTotalMemory(true)
+            let day = float t / float ticksPerDay
+            printfn "tick=%d time=%.4fs day=%.4f pos=(%.1f,%.1f) mem=%d rng=%016x" t world.Time day p.X p.Y mem world.Rng.State
+    printfn "done tick=%d non-finite=%d out-of-bounds=%d" world.Tick nonFinite outOfBounds
+    if nonFinite > 0L || outOfBounds > 0L then 1 else 0
+
+[<EntryPoint>]
+let main argv =
+    let rec parse (i: int) (days: int64 option) (seed: uint64 option) : Result<int64 * uint64, string> =
+        if i >= argv.Length then
+            match days, seed with
+            | Some d, Some s -> Ok(d, s)
+            | _ -> Error "missing --days/--seed"
+        else
+            match argv.[i] with
+            | "--days" when i + 1 < argv.Length ->
+                (match Int64.TryParse argv.[i + 1] with
+                 | true, d when d > 0L -> parse (i + 2) (Some d) seed
+                 | _ -> Error $"invalid --days '{argv.[i + 1]}'")
+            | "--seed" when i + 1 < argv.Length ->
+                (match UInt64.TryParse argv.[i + 1] with
+                 | true, s -> parse (i + 2) days (Some s)
+                 | _ -> Error $"invalid --seed '{argv.[i + 1]}'")
+            | other -> Error $"unknown argument '{other}'"
+
+    match parse 0 None None with
+    | Ok(days, seed) -> runSimulation days seed
+    | Error msg ->
+        eprintfn $"headless: {msg}"
+        eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S"
+        2