diff options
Diffstat (limited to 'src/LivingVillage.Headless')
| -rw-r--r-- | src/LivingVillage.Headless/LivingVillage.Headless.fsproj | 16 | ||||
| -rw-r--r-- | src/LivingVillage.Headless/Program.fs | 97 |
2 files changed, 113 insertions, 0 deletions
diff --git a/src/LivingVillage.Headless/LivingVillage.Headless.fsproj b/src/LivingVillage.Headless/LivingVillage.Headless.fsproj new file mode 100644 index 0000000..612b584 --- /dev/null +++ b/src/LivingVillage.Headless/LivingVillage.Headless.fsproj @@ -0,0 +1,16 @@ +<Project Sdk="Microsoft.NET.Sdk"> + + <PropertyGroup> + <OutputType>Exe</OutputType> + <TargetFramework>net8.0</TargetFramework> + </PropertyGroup> + + <ItemGroup> + <Compile Include="Program.fs" /> + </ItemGroup> + + <ItemGroup> + <ProjectReference Include="..\LivingVillage.Kernel\LivingVillage.Kernel.fsproj" /> + </ItemGroup> + +</Project> 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 |
