Repository: bcarruthers/garnet Branch: master Commit: 11f40d9fe26d Files: 140 Total size: 738.1 KB Directory structure: gitextract_lshbfeyb/ ├── .gitignore ├── Directory.Build.props ├── Garnet.sln ├── LICENSE ├── README.md ├── RELEASE_NOTES.md ├── appveyor.yml ├── build.cmd ├── samples/ │ ├── Garnet.Numerics/ │ │ ├── Garnet.Numerics.fsproj │ │ ├── Hashing.fs │ │ ├── Noise.fs │ │ ├── Numerics.fs │ │ ├── Random.fs │ │ ├── Ranges.fs │ │ └── Vectors.fs │ ├── Garnet.Processor/ │ │ ├── Args.fs │ │ ├── Garnet.Processor.fsproj │ │ ├── PackUtility.fs │ │ └── Program.fs │ ├── Garnet.Samples.Assorted/ │ │ ├── Extensions.fs │ │ ├── Garnet.Samples.Assorted.fsproj │ │ ├── OffscreenDrawing.fs │ │ ├── Program.fs │ │ ├── SpriteDrawing.fs │ │ ├── TextDrawing.fs │ │ └── assets/ │ │ ├── fonts/ │ │ │ └── pixel-operator-regular-12.font.json │ │ └── shaders/ │ │ ├── color.frag │ │ ├── color.frag.hlsl.bytes │ │ ├── color.vert │ │ ├── color.vert.hlsl.bytes │ │ ├── texture-color.frag │ │ ├── texture-color.frag.hlsl.bytes │ │ ├── texture-color.vert │ │ └── texture-color.vert.hlsl.bytes │ ├── Garnet.Samples.CSharp/ │ │ ├── Garnet.Samples.CSharp.csproj │ │ └── Program.cs │ ├── Garnet.Samples.Flocking/ │ │ ├── Debug.fs │ │ ├── Drawing.fs │ │ ├── Functions.fs │ │ ├── Garnet.Samples.Flocking.fsproj │ │ ├── Program.fs │ │ ├── Resources.fs │ │ ├── Simulation.fs │ │ ├── Startup.fs │ │ ├── Types.fs │ │ └── assets/ │ │ ├── texture-color.frag │ │ ├── texture-color.frag.hlsl.bytes │ │ ├── texture-color.vert │ │ └── texture-color.vert.hlsl.bytes │ ├── Garnet.Samples.Roguelike/ │ │ ├── ConsoleTest.fsx │ │ ├── Drawing.fs │ │ ├── Functions.fs │ │ ├── Game.fs │ │ ├── Garnet.Samples.Roguelike.fsproj │ │ ├── Program.fs │ │ ├── Types.fs │ │ └── assets/ │ │ ├── texture-dual-color.frag │ │ └── texture-dual-color.vert │ ├── Garnet.Samples.Trixel/ │ │ ├── Drawing.fs │ │ ├── Functions.fs │ │ ├── Game.fs │ │ ├── Garnet.Samples.Trixel.fsproj │ │ ├── Gui.fs │ │ ├── Imaging.fs │ │ ├── Program.fs │ │ ├── Types.fs │ │ └── assets/ │ │ ├── texture-color.frag │ │ ├── texture-color.frag.hlsl.bytes │ │ ├── texture-color.vert │ │ └── texture-color.vert.hlsl.bytes │ ├── Garnet.Toolkit/ │ │ ├── Audio.fs │ │ ├── Collections.fs │ │ ├── Colors.fs │ │ ├── Comparisons.fs │ │ ├── Events.fs │ │ ├── Fonts.fs │ │ ├── Garnet.Toolkit.fsproj │ │ ├── Input.fs │ │ ├── Logging.fs │ │ ├── Looping.fs │ │ ├── Meshes.fs │ │ ├── Offscreen.fs │ │ ├── Particles.fs │ │ ├── Picking.fs │ │ ├── Pipelines.fs │ │ ├── Rendering.fs │ │ ├── Requests.fs │ │ ├── Serialization.fs │ │ ├── Shaders.fs │ │ ├── Sprites.fs │ │ ├── Systems.fs │ │ ├── Textures.fs │ │ ├── Tiling.fs │ │ ├── Timing.fs │ │ ├── Vertices.fs │ │ └── Window.fs │ └── README.md ├── src/ │ └── Garnet/ │ ├── Actors.fs │ ├── Channels.fs │ ├── Collections.fs │ ├── Comparisons.fs │ ├── Components.fs │ ├── Containers.fs │ ├── Coroutines.fs │ ├── Entities.fs │ ├── Formatting.fs │ ├── Garnet.fsproj │ ├── Messaging.fs │ ├── Queries.fs │ ├── Registry.fs │ ├── Resources.fs │ └── Segments.fs └── tests/ └── Garnet.Tests/ ├── ActorTests.fs ├── Assertions.fs ├── Benchmarks/ │ ├── ActorBenchmarks.fs │ ├── ActorBenchmarks.fsx │ ├── ChannelBenchmarks.fs │ ├── ChannelBenchmarks.fsx │ ├── ContainerBenchmarks.fs │ └── ContainerBenchmarks.fsx ├── ChannelTests.fs ├── CollectionTests.fs ├── ComponentTests.fs ├── CoroutineTests.fs ├── EntityTests.fs ├── Garnet.Tests.fsproj ├── Iteration.fs ├── IterationTests.fs ├── Main.fs ├── QueryTests.fs ├── ReadmeSamples.fs ├── Recording.fs ├── RegistryTests.fs ├── RingBuffer.fs ├── Scratch.fsx ├── SegmentTests.fs ├── Serialization.fs ├── SerializationTests.fs ├── StateMachineTests.fs └── StrategySample.fs ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ *.suo *.swp *.user *.userprefs *.pidb *.nupkg *.sln.ide *.orig *.vsp *.psess *.vspx *.stackdump .idea/ .fake/ .vs/ .vscode/ .ionide packages/ build/ publish/ artifacts/ BenchmarkDotNet.Artifacts/ bin obj #Paket dependency manager .paket/ paket-files/ ================================================ FILE: Directory.Build.props ================================================ 0.5.3 Ben Carruthers Copyright © 2021 Ben Carruthers MIT false https://github.com/bcarruthers/garnet ================================================ FILE: Garnet.sln ================================================  Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 16 VisualStudioVersion = 16.0.29215.179 MinimumVisualStudioVersion = 15.0.26124.0 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Garnet", "src\Garnet\Garnet.fsproj", "{4FA4BEC9-C501-40F7-B0F2-B204A932E27B}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Garnet.Tests", "tests\Garnet.Tests\Garnet.Tests.fsproj", "{97D1D0D1-C635-4725-A892-DE1852A0CB4C}" EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Samples", "Samples", "{1E82F9DC-427D-46D1-9352-FB1E97724CAF}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Garnet.Toolkit", "samples\Garnet.Toolkit\Garnet.Toolkit.fsproj", "{E0F6649F-E652-4B34-B0AA-1E6716AB60FF}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Garnet.Samples.Flocking", "samples\Garnet.Samples.Flocking\Garnet.Samples.Flocking.fsproj", "{16290883-031E-408F-B599-5FEE33355629}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Garnet.Samples.Roguelike", "samples\Garnet.Samples.Roguelike\Garnet.Samples.Roguelike.fsproj", "{C7826D8F-8343-440B-BD6D-74F73D6814EC}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Garnet.Samples.Trixel", "samples\Garnet.Samples.Trixel\Garnet.Samples.Trixel.fsproj", "{58AB7F65-F130-4624-9458-A4BC5BF867DC}" EndProject Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Garnet.Samples.CSharp", "samples\Garnet.Samples.CSharp\Garnet.Samples.CSharp.csproj", "{AF60F947-ED94-4B84-BF8E-D327D2CFCE41}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Garnet.Numerics", "samples\Garnet.Numerics\Garnet.Numerics.fsproj", "{66F27C8C-B121-426B-BEA2-4379FC217849}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Garnet.Samples.Assorted", "samples\Garnet.Samples.Assorted\Garnet.Samples.Assorted.fsproj", "{957D6CB2-EBFD-42A8-A201-731CBA232FB3}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Garnet.Processor", "samples\Garnet.Processor\Garnet.Processor.fsproj", "{C88FF8AF-962A-4162-8FB8-0D337DA09138}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU Debug|x64 = Debug|x64 Debug|x86 = Debug|x86 Release|Any CPU = Release|Any CPU Release|x64 = Release|x64 Release|x86 = Release|x86 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|Any CPU.Build.0 = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|x64.ActiveCfg = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|x64.Build.0 = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|x86.ActiveCfg = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Debug|x86.Build.0 = Debug|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|Any CPU.ActiveCfg = Release|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|Any CPU.Build.0 = Release|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|x64.ActiveCfg = Release|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|x64.Build.0 = Release|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|x86.ActiveCfg = Release|Any CPU {4FA4BEC9-C501-40F7-B0F2-B204A932E27B}.Release|x86.Build.0 = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|Any CPU.Build.0 = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|x64.ActiveCfg = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|x64.Build.0 = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|x86.ActiveCfg = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Debug|x86.Build.0 = Debug|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|Any CPU.ActiveCfg = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|Any CPU.Build.0 = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|x64.ActiveCfg = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|x64.Build.0 = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|x86.ActiveCfg = Release|Any CPU {97D1D0D1-C635-4725-A892-DE1852A0CB4C}.Release|x86.Build.0 = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|Any CPU.Build.0 = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|x64.ActiveCfg = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|x64.Build.0 = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|x86.ActiveCfg = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Debug|x86.Build.0 = Debug|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|Any CPU.ActiveCfg = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|Any CPU.Build.0 = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|x64.ActiveCfg = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|x64.Build.0 = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|x86.ActiveCfg = Release|Any CPU {E0F6649F-E652-4B34-B0AA-1E6716AB60FF}.Release|x86.Build.0 = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|Any CPU.Build.0 = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|x64.ActiveCfg = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|x64.Build.0 = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|x86.ActiveCfg = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Debug|x86.Build.0 = Debug|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|Any CPU.ActiveCfg = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|Any CPU.Build.0 = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|x64.ActiveCfg = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|x64.Build.0 = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|x86.ActiveCfg = Release|Any CPU {16290883-031E-408F-B599-5FEE33355629}.Release|x86.Build.0 = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|Any CPU.Build.0 = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|x64.ActiveCfg = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|x64.Build.0 = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|x86.ActiveCfg = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Debug|x86.Build.0 = Debug|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|Any CPU.ActiveCfg = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|Any CPU.Build.0 = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|x64.ActiveCfg = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|x64.Build.0 = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|x86.ActiveCfg = Release|Any CPU {C7826D8F-8343-440B-BD6D-74F73D6814EC}.Release|x86.Build.0 = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|Any CPU.Build.0 = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|x64.ActiveCfg = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|x64.Build.0 = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|x86.ActiveCfg = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Debug|x86.Build.0 = Debug|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|Any CPU.ActiveCfg = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|Any CPU.Build.0 = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|x64.ActiveCfg = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|x64.Build.0 = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|x86.ActiveCfg = Release|Any CPU {58AB7F65-F130-4624-9458-A4BC5BF867DC}.Release|x86.Build.0 = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|Any CPU.Build.0 = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|x64.ActiveCfg = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|x64.Build.0 = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|x86.ActiveCfg = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Debug|x86.Build.0 = Debug|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|Any CPU.ActiveCfg = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|Any CPU.Build.0 = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|x64.ActiveCfg = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|x64.Build.0 = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|x86.ActiveCfg = Release|Any CPU {AF60F947-ED94-4B84-BF8E-D327D2CFCE41}.Release|x86.Build.0 = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|Any CPU.Build.0 = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|x64.ActiveCfg = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|x64.Build.0 = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|x86.ActiveCfg = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Debug|x86.Build.0 = Debug|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|Any CPU.ActiveCfg = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|Any CPU.Build.0 = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|x64.ActiveCfg = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|x64.Build.0 = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|x86.ActiveCfg = Release|Any CPU {66F27C8C-B121-426B-BEA2-4379FC217849}.Release|x86.Build.0 = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|Any CPU.Build.0 = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|x64.ActiveCfg = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|x64.Build.0 = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|x86.ActiveCfg = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Debug|x86.Build.0 = Debug|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|Any CPU.ActiveCfg = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|Any CPU.Build.0 = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|x64.ActiveCfg = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|x64.Build.0 = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|x86.ActiveCfg = Release|Any CPU {957D6CB2-EBFD-42A8-A201-731CBA232FB3}.Release|x86.Build.0 = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|Any CPU.Build.0 = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|x64.ActiveCfg = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|x64.Build.0 = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|x86.ActiveCfg = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Debug|x86.Build.0 = Debug|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|Any CPU.ActiveCfg = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|Any CPU.Build.0 = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|x64.ActiveCfg = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|x64.Build.0 = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|x86.ActiveCfg = Release|Any CPU {C88FF8AF-962A-4162-8FB8-0D337DA09138}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(NestedProjects) = preSolution {E0F6649F-E652-4B34-B0AA-1E6716AB60FF} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {16290883-031E-408F-B599-5FEE33355629} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {C7826D8F-8343-440B-BD6D-74F73D6814EC} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {58AB7F65-F130-4624-9458-A4BC5BF867DC} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {AF60F947-ED94-4B84-BF8E-D327D2CFCE41} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {66F27C8C-B121-426B-BEA2-4379FC217849} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {957D6CB2-EBFD-42A8-A201-731CBA232FB3} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} {C88FF8AF-962A-4162-8FB8-0D337DA09138} = {1E82F9DC-427D-46D1-9352-FB1E97724CAF} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {D7FA662D-CCF7-4CEF-82D0-82F96A334562} EndGlobalSection GlobalSection(Performance) = preSolution HasPerformanceSessions = true EndGlobalSection EndGlobal ================================================ FILE: LICENSE ================================================ MIT License Copyright (c) 2019 Ben Carruthers Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: README.md ================================================ # Garnet [![Build status](https://ci.appveyor.com/api/projects/status/g82kak7btxp48rnd?svg=true)](https://ci.appveyor.com/project/bcarruthers/garnet) [NuGet package](https://www.nuget.org/packages/Garnet/) Garnet is a lightweight game composition library for F# with entity-component-system (ECS) and actor-like messaging features. ```fsharp open Garnet.Composition // events [] type Update = { dt : float32 } // components [] type Position = { x : float32; y : float32 } [] type Velocity = { vx : float32; vy : float32 } // create a world let world = Container() // register a system that updates position let system = world.On <| fun e -> for r in world.Query() do let p = &r.Value1 let v = r.Value2 p <- { x = p.x + v.vx * e.dt y = p.y + v.vy * e.dt } // add an entity to world let entity = world.Create() .With({ x = 10.0f; y = 5.0f }) .With({ vx = 1.0f; vy = 2.0f }) // run updates and print world state for i = 1 to 10 do world.Run <| { dt = 0.1f } printfn "%O\n\n%O\n\n" world entity ``` ## Table of contents * Introduction * [Getting started](#gettingstarted) * [Background](#background) * [Goals](#goals) * Guide * [Containers](#containers) * [Entities](#entities) * [Components](#components) * [Systems](#systems) * [Actors](#actors) * [Integration](#integration) * [FAQ](#faq) * [License](#license) * [Maintainers](#maintainers) ## Getting started 1. Create either a .NET Framework, Core, or 6.0+ application. 2. Reference the [Garnet NuGet package](https://www.nuget.org/packages/Garnet/). 3. For sample code, see unit tests or [sample projects](https://github.com/bcarruthers/garnet/tree/master/samples). ## Background ECS is a common architecture for games, often contrasted with OOP inheritance. It focuses on separation of data and behavior and is typically implemented in a data-oriented way to achieve high performance. It's similar to a database, where component tables are related using a common entity ID, allowing systems to query and iterate over entities with specific combinations of components present. EC (entity-component) is a related approach that attaches behavior to components and avoids systems. While ECS focuses on managing shared state, the actor model isolates state into separate actors which communicate only through messages. Actors can send and receive messages, change their behavior as a result of messages, and create new actors. This approach offers scaleability and an abstraction layer over message delivery, and games can use it at a high level to model independent processes, worlds, or agents. ## Goals - **Lightweight**: Garnet is essentially a simplified in-memory database and messaging system suitable for games. No inheritance, attributes, or interface implementations are required in your code. It's more of a library than a framework or engine, and most of your code shouldn't depend on it. - **Fast**: Garbage collection spikes can cause dropped frames and inconsistent performance, so Garnet minimizes allocations and helps library users do so too. Component storage is data-oriented for fast iteration. - **Minimal**: The core library focuses on events, scheduling, and storage, and anything game-specific like physics, rendering, or update loops should be implemented separately. ## Containers ECS containers provide a useful bundle of functionality for working with shared game state, including event handling, component storage, entity ID generation, coroutine scheduling, and resource resolution. ```fsharp // create a container/world let c = Container() ``` ### Registry Containers store single instances of types such as component lists, ID pools, settings, and any other arbitrary type. You can access instances by type, with optional lazy resolution. This is the service locator (anti-)pattern. ```fsharp // option 1: add specific instance c.SetValue(defaultWorldSettings) // option 2: register a factory c.SetFactory(fun () -> defaultWorldSettings) // resolve type let settings = c.GetValue() ``` This works for value types as well: ```fsharp c.SetValue { zoomLevel = 0.5f } let zoom = c.GetValue>() ``` ### Object pooling Avoiding GC generally amounts to use of structs, pooling, and avoiding closures. Almost all objects are either pooled within a container or on the stack, so there's little or no GC impact or allocation once maximum load is reached. If needed, warming up or provisioning buffers ahead of time is possible for avoiding GC entirely during gameplay. ### Commits Certain operations on containers, such as sending events or adding/removing components, are staged until a commit occurs, allowing any running event handlers to observe the original state. Commits occur automatically after all subscribers have completed handling a list of events, so you typically shouldn't need to explicitly commit. ```fsharp // create an entity let e = c.Create().With("test") // not yet visible c.Commit() // now visible ``` ## Entities An entity is any identifiable thing in your game which you can attach components to. At minimum, an entity consists only of an entity ID. ### Entity ID Entity IDs are 32 bits and stored in a component list. This means they can be accessed and iterated over like any other component type without special handling. IDs use a special Eid type rather than a raw int32, which offers better type safety but means you need a direct dependency on Garnet if you want to define types with an Eid (or you can manage converting to your own ID type if this is an issue). ```fsharp let entity = c.Create() printfn "%A" entity.id ``` ### Generations A portion of an ID is dedicated to its generation number. The purpose of a generation is to avoid reusing IDs while still allowing buffer slots to be reused, keeping components stored as densely as possible. ### Partitioning Component storage could become inefficient if it grows too sparse (i.e. the average number of occupied elements per segment becomes low). If this is a concern (or you just want to organize your entities), you can optionally use partitions to specify a high bit mask in ID generation. For example, if ship and bullet entities shared the same ID space, they may become mixed over time and the ship components would become sparse. Instead, with separate partitions, both entities would remain dense. Note: this will likely be replaced with groups in the future. ### Generic storage Storage should work well for both sequential and sparse data and support generic key types. Entity IDs are typically used as keys, but other types like grid location should be possible as well. ### Inspecting You can print the components of an entity at any time, which is useful in REPL scenarios as an alternative to using a debugger. ```fsharp printfn "%s" <| c.Get(Eid 64).ToString() ``` ``` Entity 0x40: 20 bytes Eid 0x40 Loc {x = 10; y = 2;} UnitType Archer UnitSize {unitSize = 5;} ``` ## Components Components are any arbitrary data type associated with an entity. Combined with systems that operate on them, components provide a way to specify behavior or capabilities of entities. ### Data types Components should ideally be pure data rather than classes with behavior and dependencies. They should typically be structs to avoid jumping around in memory or incurring allocations and garbage collection. Structs should almost always be immutable, but mutable structs (with their gotchas) are possible too. ```fsharp [] type Position = { x : float32; y : float32 } [] type Velocity = { vx : float32; vy : float32 } // create an entity and add two components to it let entity = c.Create() .With({ x = 10.0f; y = 5.0f }) .With({ vx = 1.0f; vy = 2.0f }) ``` ### Storage Components are stored in 64-element segments with a mask, ordered by ID. This provides CPU-friendly iteration over densely stored data while retaining some benefits of sparse storage. Some ECS implementations provide a variety of specialized data structures, but Garnet attempts a middle ground that works moderately well for both sequential entity IDs and sparse keys such as grid locations. Only a single component of a type is allowed per entity, but there is no hard limit on the total number of different component types used (i.e. there is no fixed-size mask defining which components an entity has). ### Iteration You can iterate over entities with specific combinations of components using queries. In this way you could define a system that updates all entities with a position and velocity, and iteration would skip over any entities with only a position and not velocity. ```fsharp let healthSub = c.On <| fun e -> for r in c.Query() do let h = r.Value3 if h.hp <= 0 then let eid = r.Value1 c.Destroy(eid) ``` For batch operations or to improve performance further, you can iterate over segments: ```fsharp let healthSub = c.On <| fun e -> for seg, eids, _, hs in c.QuerySegments() do for i in seg do let h = hs.[i] if h.hp <= 0 then let eid = eids.[i] c.Destroy(eid) ``` Note that writes to existing components during iteration occur immediately, unlike adding or removing components. ### Adding Additions are deferred until a commit occurs, so any code dependent on those operations completing needs to be implemented as a coroutine. ```fsharp let e = c.Get(Eid 100) e.Add { x = 1.0f; y = 2.0f } // change not yet visible ``` ### Removing Like additions, removals are also deferred until commit. Note that you can repeatedly add and remove components for the same entity ID before a commit if needed. ```fsharp e.Remove() // change not yet visible ``` ### Updating Unlike additions and removals, updating/replacing an existing component can be done directly at the risk of affecting subsequent subscribers. This way is convenient if the update operation is commutative or there are no other subscribers writing to the same component type during the same event. You can alternately just use addition if you don't know whether a component is already present. ```fsharp let e = c.Get(Eid 100) e.Set { x = 1.0f; y = 2.0f } // change immediately visible ``` ### Markers You can define empty types for use as flags or markers, in which case only 64-bit masks need to be stored per segment. Markers are an efficient way to define static groups for querying. ```fsharp type PowerupMarker = struct end ``` ## Systems Systems are essentially event subscribers with an optional name. System event handlers often iterate over entities, such as updating position based on velocity, but they can do any other kind of processing too. ```fsharp module MovementSystem = // separate methods as needed let registerUpdate (c : Container) = c.On <| fun e -> printfn "%A" e // combine all together let register (c : Container) = Disposable.Create [ registerUpdate c ] ``` Alternately, you can define systems as extension methods. This way is more OOP-centric and avoids some redundancy in declarations. ```fsharp [] module MovementSystem = type Container with member c.AddMovementUpdate() = c.On <| fun e -> printfn "%A" e member c.AddMovementSystems() = Disposable.Create [ c.AddMovementUpdate() ] ``` ### Execution When any code creates or modifies entities, sends events, or starts coroutines, it's only staging those things. To actually set all of it into motion, you need to run the container, which would typically happen as part of the game loop. Each time you run the container, it commits all changes, publishes events, and advances coroutines, repeating this process until no work remains to do. This means you should avoid introducing cycles like two systems responding to each other unless they are part of a timed coroutine. ```fsharp // run the container c.Process() ``` ### Events Like components, you can use any arbitrary type for an event, but structs are generally preferable to avoid GC. When events are published, subscribers receive batches of events with no guaranteed ordering among the subscribers or event types. Any additional events raised during event handling are run after all the original event handlers complete, thereby avoiding any possibility of reentrancy but complicating synchronous behavior. ```fsharp [] type UpdateTime = { dt : float32 } // call sub.Dispose() to unsubscribe let sub = c.On <| fun e -> // [do update here] printfn "%A" e // send event c.Send { dt = 0.1f } ``` Events intentionally decouple publishers and subscribers, and since dispatching events is typically not synchronous within the ECS, it can be difficult to trace the source of events when something goes wrong (no callstack). ### Coroutines Coroutines allow capturing state and continuing processing for longer than the handling of a single event. They are implemented as sequences and can be used to achieve synchronous behavior despite the asynchronous nature of event handling. This is one of the few parts of the code which incurs allocation. Coroutines run until they encounter a yield statement, which can tell the coroutine scheduler to either wait for a time duration or to wait until all nested processing has completed. Nested processing refers to any coroutines created as a result of events sent by the current coroutine, allowing a stack-like flow and ordering of events. ```fsharp let system = c.On <| fun e -> printf "2 " // start a coroutine c.Start <| seq { printf "1 " // send message and defer execution until all messages and // coroutines created as a result of this have completed c.Send <| Msg() yield Wait.All printf "3 " } // run until completion // output: 1 2 3 c.Process() ``` Time-based coroutines are useful for animations or delayed effects. You can use any unit of time as long as it's consistent. ```fsharp // start a coroutine c.Start <| seq { for i = 1 to 5 do printf "[%d] " i // yield execution until time units pass yield Wait.time 3L } // run update loop // output: [1] 1 2 3 [2] 4 5 6 [3] 7 8 9 for i = 1 to 9 do // increment time units and run pending coroutines c.Step 1L c.Process() printf "%d " i ``` ### Multithreading It's often useful to run physics in parallel with other processing that doesn't depend on its output, but the event system currently has no built-in features to facilitate multiple threads reading or writing. Instead, you can use the actor system for parallel execution at a higher level, or you can implement your own multithreading at the container level. ### Event ordering For systems that subscribe to the same event and access the same resources or components, you need to consider whether one is dependent on the other and should run first. One way to guarantee ordering is to define individual sub-events for the systems and publish those events in the desired order as part of a coroutine started from the original event (with waits following each event to ensure all subscribers are run before proceeding). ```fsharp // events type Update = struct end type UpdatePhysicsBodies = struct end type UpdateHashSpace = struct end // systems let updateSystem = c.On <| fun e -> c.Start <| seq { // sending and suspending execution to // achieve ordering of sub-updates c.Send <| UpdatePhysicsBodies() yield Wait.All c.Send <| UpdateHashSpace() yield Wait.All } let system1 = c.On <| fun e -> // [update positions] printfn "%A" e let system2 = c.On <| fun e -> // [update hash space from positions] printfn "%A" e ``` ### Composing systems Since systems are just named event subscriptions, you can compose them into larger systems. This allows for bundling related functionality. ```fsharp module CoreSystems = let register (c : Container) = Disposable.Create [ MovementSystem.register c HashSpaceSystem.register c ] ``` ## Actors While ECS containers provide a simple and fast means of storing and updating shared memory state using a single thread, actors share no common state and communicate only through messages, making them suitable for parallel processing. ### Definitions Actors are identified by an actor ID. They are statically defined and created on demand when a message is sent to a nonexistent actor ID. At that point, an actor consisting of a message handler is created based on any definitions registered in the actor system that match the actor ID. It's closer to a mailbox processor than a complete actor model since these actors can't dynamically create arbitrary actors or control actor lifetimes. ```fsharp // message types type Ping = struct end type Pong = struct end // actor definitions let a = new ActorSystem() a.Register(ActorId 1, fun (c : Container) -> c.On <| fun e -> printf "ping " c.Respond(Pong()) ) a.Register(ActorId 2, fun (c : Container) -> c.On <| fun e -> printf "pong " ) // send a message and run until all complete // output: ping pong a.Send(ActorId 1, Ping(), sourceId = ActorId 2) a.ProcessAll() ``` ### Actor messages versus container events Containers already have their own internal event system, but the semantics are a bit different from actors because container events are always stored in separate channels by event type rather than a single serialized channel for all actor message types. The use of separate channels within containers allows for efficient batch processing in cases where event types have no ordering dependencies, but ordering by default is preferable in many other cases involving actors. ### Wrapping containers It's useful to wrap a container within an actor, where incoming messages to the actor automatically dispatched to the container, and systems within the container have access to an outbox for sending messages to other actors. This approach allows keeping isolated worlds, such as a subset of world state for AI forces or UI state. ### Replay debugging If you can write logic where your game state is fully determined by the sequence of incoming messages, you can log these messages and replay them to diagnose bugs. This works best if you can isolate the problem to a single actor, such as observing incorrect state or incorrect outgoing messages given a correct input sequence. ### Message ordering Messages sent from one actor to another are guaranteed to arrive in the order they were sent, but they may be interleaved with messages arriving from other actors. In general, multiple actors and parallelism can introduce complexity similar to the use of microservices, which address scaleability but can introduce race conditions and challenges in synchronization. ### Multithreading You can designate actors to run on either the main thread (for UI if needed) or a background thread. Actors run when a batch of messages is delivered, resembling task-based parallelism. In addition to running designated actors, the main thread also delivers messages among actors, although this could change in the future if it becomes a bottleneck. Background actors currently run using a fixed pool of worker threads. ## Integration How does Garnet integrate with frameworks or engines like Unity, MonoGame, or Veldrid? You have a few options depending on how much you want to depend on Garnet, your chosen framework, and your own code. This approach also works for integrating narrower libraries like physics or networking. See [sample projects](https://github.com/bcarruthers/garnet/tree/master/samples) for integration with Veldrid and OpenAL. ### Abstracting framework calls When you need to call the framework (e.g. MonoGame) from your code, you can choose to insulate your code from the framework with an abstraction layer. This reduces your dependency on it, but it takes more effort and may result in less power to use framework-specific features and more overhead in marshaling data. If you decide to abstract, you have several options for defining the abstraction layer: - **Services**: Register an interface for a subsystem and provide an implemention for the specific framework, e.g. *ISpriteRenderer* with *MonoGameSpriteRenderer*. This makes sense if you want synchronous calls or an explicit interface. - **Events**: Define interface event types and framework-specific systems which subscribe to them, e.g. a sprite rendering system subscribing to *DrawSprite* events. This way is more decoupled, but the interface may not be so clear. - **Components**: Define interface component types and implement framework-specific systems which iterate over them, e.g. a sprite rendering system which iterates over entities with a *Sprite* component. ### Sending framework events For the reverse direction, when you want the framework to call your code, you can simply send interface event types and run the container or actors. ```fsharp type Game() = // ... let world = Container() // [configure container here] override c.Update gt = world.Run { deltaTime = gt.ElapsedGameTime } override c.Draw gameTime = world.Run <| Draw() ``` ## FAQ - **Why F#?** F# offers conciseness, functional-first defaults like immutability, an algebraic type system, interactive code editing, and pragmatic support for other paradigms like OOP. Strong type safety makes it more likely that code is correct, which is especially helpful for tweaking game code that changes frequently enough to make unit testing impractical. - **What about performance?** Functional code often involves allocation, which sometimes conflicts with the goal of consistent performance when garbage collection occurs. A goal of this library is to reduce the effort in writing code that minimizes allocation. But for simple games, this is likely a non-issue and you should start with idiomatic code. - **Why use ECS over MVU?** You probably shouldn't start with ECS for a simple game, at least not when prototyping, unless you already have a good understanding of where it might be beneficial. MVU avoids a lot of complexity and has stronger type safety and immutability guarantees than ECS, but you may encounter issues if your project has demanding performance requirements or needs more flexibility than it allows. ## License This project is licensed under the [MIT license](https://github.com/bcarruthers/garnet/blob/master/LICENSE). ## Maintainer(s) - [@bcarruthers](https://github.com/bcarruthers) ================================================ FILE: RELEASE_NOTES.md ================================================ ## 0.5.0 – 2021-10-16 - Revised registry implementation - Renamed Get() to GetComponents() - Renamed GetInstance() registry methods to Get() - Renamed Entity.Contains() to Has() - Added more toolkit functionality ## 0.4.0 – 2021-08-28 - Added new querying code - Renamed various members for consistent PascalCase - Added toolkit project and samples ## 0.3.0 – 2021-04-24 - Performance: Implemented static type ID lookup for components - Performance: Changed to generic type for segment key mapping - Added separate recipient to actor message destinations - Refactored resource loading - Added more iteration options - Fixed iteration bugs ## 0.2.0 – 2019-09-01 - Cleaned up public interfaces - Removed experimental serialization code - Decoupled entity from container - Cleaned up event publishers - Rewrote actor system - Rewrote entity ID pooling and destruction - Switched to using buffers instead of lists ## 0.1.0 – 2019-07-09 - Initial version ================================================ FILE: appveyor.yml ================================================ version: 1.0.{build} image: Visual Studio 2022 build_script: - cmd: build.cmd artifacts: - path: publish\*.nupkg name: packages deploy: - provider: GitHub auth_token: secure: qG7eOszX+IfotPE1mnKIg13cJTR1/t4aiI5coav1zcp71CZBXw4BZ6PfAU7jWZ4D artifact: packages draft: true ================================================ FILE: build.cmd ================================================ dotnet restore dotnet build --no-restore dotnet test --no-build --verbosity normal dotnet pack -c Release -o publish src\Garnet\Garnet.fsproj dotnet pack -c Release -o publish samples\Garnet.Numerics\Garnet.Numerics.fsproj dotnet pack -c Release -o publish samples\Garnet.Toolkit\Garnet.Toolkit.fsproj dotnet pack -c Release -o publish samples\Garnet.Processor\Garnet.Processor.fsproj ================================================ FILE: samples/Garnet.Numerics/Garnet.Numerics.fsproj ================================================  net6.0 Numeric primitives and operations suitable for games. Supplements System.Numerics. math vectors bounds game ================================================ FILE: samples/Garnet.Numerics/Hashing.fs ================================================ namespace Garnet.Numerics open System module Fnv1a = [] let Prime = 0x1000193u [] let Seed = 0x811c9dc5u type Fnv1a() = static member inline Combine(hash, value) = (hash ^^^ value) * Fnv1a.Prime static member inline Hash(x1 : uint32) = let h = Fnv1a.Seed let h = Fnv1a.Combine(h, x1) h static member inline Hash(x1 : uint32, x2 : uint32) = let h = Fnv1a.Seed let h = Fnv1a.Combine(h, x1) let h = Fnv1a.Combine(h, x2) h static member inline Hash(x1 : uint32, x2 : uint32, x3 : uint32) = let h = Fnv1a.Seed let h = Fnv1a.Combine(h, x1) let h = Fnv1a.Combine(h, x2) let h = Fnv1a.Combine(h, x3) h static member inline Hash(key : string) = let mutable hash = Fnv1a.Seed for i = 0 to key.Length - 1 do let value = uint32 key.[i] hash <- Fnv1a.Combine(hash, value) hash module Fnv1a64 = [] let Prime = 0x100000001b3UL [] let Seed = 0xcbf29ce484222325UL type Fnv1a64() = static member inline Combine(hash, value) = (hash ^^^ value) * Fnv1a64.Prime static member inline Hash(value : uint64) = let h = Fnv1a64.Seed let h = Fnv1a64.Combine(h, value) h static member inline Hash(x1 : uint64, x2 : uint64) = let h = Fnv1a64.Seed let h = Fnv1a64.Combine(h, x1) let h = Fnv1a64.Combine(h, x2) h static member inline Hash(x1 : uint64, x2 : uint64, x3 : uint64) = let h = Fnv1a64.Seed let h = Fnv1a64.Combine(h, x1) let h = Fnv1a64.Combine(h, x2) let h = Fnv1a64.Combine(h, x3) h static member inline Hash(key : string) = let mutable hash = Fnv1a64.Seed for i = 0 to key.Length - 1 do let value = uint64 key.[i] hash <- Fnv1a64.Combine(hash, value) hash module XXHash = [] let Prime32_1 = 2654435761u [] let Prime32_2 = 2246822519u [] let Prime32_3 = 3266489917u [] let Prime32_4 = 668265263u [] let Prime32_5 = 374761393u type XXHash() = static member inline RotateLeft(value : uint32, count) = (value <<< count) ||| (value >>> (32 - count)) static member inline Finalize(hash : uint32) = let h = hash ^^^ (hash >>> 15) let h = h * XXHash.Prime32_2 let h = h ^^^ (h >>> 13) let h = h * XXHash.Prime32_3 let h = h ^^^ (h >>> 16) h static member inline Combine(hash : uint32, value : uint32) = let h = hash + value * XXHash.Prime32_3 let h = XXHash.RotateLeft(h, 17) * XXHash.Prime32_4 h static member inline Initialize(seed : uint32) = seed + XXHash.Prime32_5 static member inline Initialize(seed : uint32, size : uint32) = let h = seed + XXHash.Prime32_5 let h = h + size h static member inline Hash(seed : uint32, value : uint32) = let h = XXHash.Initialize(seed, 4u) let h = XXHash.Combine(h, value) XXHash.Finalize(h) static member inline Hash(seed : uint32, x1 : uint32, x2 : uint32) = let h = XXHash.Initialize(seed, 8u) let h = XXHash.Combine(h, x1) let h = XXHash.Combine(h, x2) XXHash.Finalize(h) static member inline Hash(seed : uint32, x1 : uint32, x2 : uint32, x3 : uint32) = let h = XXHash.Initialize(seed, 12u) let h = XXHash.Combine(h, x1) let h = XXHash.Combine(h, x2) let h = XXHash.Combine(h, x3) XXHash.Finalize(h) static member inline Hash(seed : uint32, span : ReadOnlySpan) = let mutable h = XXHash.Initialize(seed, uint32 span.Length) for i = 0 to span.Length - 1 do h <- XXHash.Combine(h, uint32 span.[i]) XXHash.Finalize(h) static member inline Hash(seed : uint32, span : ReadOnlySpan) = let mutable h = XXHash.Initialize(seed, uint32 (span.Length * 2)) for i = 0 to span.Length - 1 do h <- XXHash.Combine(h, uint32 (span.[i] &&& 0xffffffffUL)) h <- XXHash.Combine(h, uint32 (span.[i] >>> 32)) XXHash.Finalize(h) static member inline FinalizeToRange(hash, index, min, max) = let h = XXHash.Combine(hash, uint32 index) let h = XXHash.Finalize(h) int (h % uint32 (max - min)) + min ================================================ FILE: samples/Garnet.Numerics/Noise.fs ================================================ namespace Garnet.Numerics // Adapted for F# from Stefan Gustavson code // Simplex noise demystified: // https://weber.itn.liu.se/~stegu/simplexnoise/simplexnoise.pdf // Original license: // sdnoise1234, Simplex noise with true analytic // derivative in 1D to 4D. // // Copyright © 2003-2012, Stefan Gustavson // // Contact: stefan.gustavson@gmail.com // // This library is public domain software, released by the author // into the public domain in February 2011. You may do anything // you like with it. You may even remove all attributions, // but of course I'd appreciate it if you kept my name somewhere. // // This library is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU // General Public License for more details. // // This is an implementation of Perlin "simplex noise" over one // dimension (x), two dimensions (x,y), three dimensions (x,y,z) // and four dimensions (x,y,z,w). The analytic derivative is // returned, to make it possible to do lots of fun stuff like // flow animations, curl noise, analytic antialiasing and such. // // Visually, this noise is exactly the same as the plain version of // simplex noise provided in the file "snoise1234.c". It just returns // all partial derivatives in addition to the scalar noise value. open System.Numerics module private SimplexNoise = let private grad3 = array2D [[1.0f;1.0f;0.0f];[-1.0f;1.0f;0.0f];[1.0f;-1.0f;0.0f];[-1.0f;-1.0f;0.0f]; [1.0f;0.0f;1.0f];[-1.0f;0.0f;1.0f];[1.0f;0.0f;-1.0f];[-1.0f;0.0f;-1.0f]; [0.0f;1.0f;1.0f];[0.0f;-1.0f;1.0f];[0.0f;1.0f;-1.0f];[0.0f;-1.0f;-1.0f]]; let private grad4 = array2D [[0.0f;1.0f;1.0f;1.0f]; [0.0f;1.0f;1.0f;-1.0f]; [0.0f;1.0f;-1.0f;1.0f]; [0.0f;1.0f;-1.0f;-1.0f]; [0.0f;-1.0f;1.0f;1.0f]; [0.0f;-1.0f;1.0f;-1.0f]; [0.0f;-1.0f;-1.0f;1.0f]; [0.0f;-1.0f;-1.0f;-1.0f]; [1.0f;0.0f;1.0f;1.0f]; [1.0f;0.0f;1.0f;-1.0f]; [1.0f;0.0f;-1.0f;1.0f]; [1.0f;0.0f;-1.0f;-1.0f]; [-1.0f;0.0f;1.0f;1.0f]; [-1.0f;0.0f;1.0f;-1.0f]; [-1.0f;0.0f;-1.0f;1.0f]; [-1.0f;0.0f;-1.0f;-1.0f]; [1.0f;1.0f;0.0f;1.0f]; [1.0f;1.0f;0.0f;-1.0f]; [1.0f;-1.0f;0.0f;1.0f]; [1.0f;-1.0f;0.0f;-1.0f]; [-1.0f;1.0f;0.0f;1.0f]; [-1.0f;1.0f;0.0f;-1.0f]; [-1.0f;-1.0f;0.0f;1.0f]; [-1.0f;-1.0f;0.0f;-1.0f]; [1.0f;1.0f;1.0f;0.0f]; [1.0f;1.0f;-1.0f;0.0f]; [1.0f;-1.0f;1.0f;0.0f]; [1.0f;-1.0f;-1.0f;0.0f]; [-1.0f;1.0f;1.0f;0.0f]; [-1.0f;1.0f;-1.0f;0.0f]; [-1.0f;-1.0f;1.0f;0.0f]; [-1.0f;-1.0f;-1.0f;0.0f]]; // A lookup table to traverse the simplex around a given point in 4D. // Details can be found where this table is used; in the 4D noise method. let private simplex = array2D [[0;1;2;3];[0;1;3;2];[0;0;0;0];[0;2;3;1];[0;0;0;0];[0;0;0;0];[0;0;0;0];[1;2;3;0]; [0;2;1;3];[0;0;0;0];[0;3;1;2];[0;3;2;1];[0;0;0;0];[0;0;0;0];[0;0;0;0];[1;3;2;0]; [0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0]; [1;2;0;3];[0;0;0;0];[1;3;0;2];[0;0;0;0];[0;0;0;0];[0;0;0;0];[2;3;0;1];[2;3;1;0]; [1;0;2;3];[1;0;3;2];[0;0;0;0];[0;0;0;0];[0;0;0;0];[2;0;3;1];[0;0;0;0];[2;1;3;0]; [0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0]; [2;0;1;3];[0;0;0;0];[0;0;0;0];[0;0;0;0];[3;0;1;2];[3;0;2;1];[0;0;0;0];[3;1;2;0]; [2;1;0;3];[0;0;0;0];[0;0;0;0];[0;0;0;0];[3;1;0;2];[0;0;0;0];[3;2;0;1];[3;2;1;0]]; // Permutation table. This is just a random jumble of all numbers 0-255; // repeated twice to avoid wrapping the index at 255 for each lookup. let private perm = [| 151;160;137;91;90;15; 131;13;201;95;96;53;194;233;7;225;140;36;103;30;69;142;8;99;37;240;21;10;23; 190; 6;148;247;120;234;75;0;26;197;62;94;252;219;203;117;35;11;32;57;177;33; 88;237;149;56;87;174;20;125;136;171;168; 68;175;74;165;71;134;139;48;27;166; 77;146;158;231;83;111;229;122;60;211;133;230;220;105;92;41;55;46;245;40;244; 102;143;54; 65;25;63;161; 1;216;80;73;209;76;132;187;208; 89;18;169;200;196; 135;130;116;188;159;86;164;100;109;198;173;186; 3;64;52;217;226;250;124;123; 5;202;38;147;118;126;255;82;85;212;207;206;59;227;47;16;58;17;182;189;28;42; 223;183;170;213;119;248;152; 2;44;154;163; 70;221;153;101;155;167; 43;172;9; 129;22;39;253; 19;98;108;110;79;113;224;232;178;185; 112;104;218;246;97;228; 251;34;242;193;238;210;144;12;191;179;162;241; 81;51;145;235;249;14;239;107; 49;192;214; 31;181;199;106;157;184; 84;204;176;115;121;50;45;127; 4;150;254; 138;236;205;93;222;114;67;29;24;72;243;141;128;195;78;66;215;61;156;180; 151;160;137;91;90;15; 131;13;201;95;96;53;194;233;7;225;140;36;103;30;69;142;8;99;37;240;21;10;23; 190; 6;148;247;120;234;75;0;26;197;62;94;252;219;203;117;35;11;32;57;177;33; 88;237;149;56;87;174;20;125;136;171;168; 68;175;74;165;71;134;139;48;27;166; 77;146;158;231;83;111;229;122;60;211;133;230;220;105;92;41;55;46;245;40;244; 102;143;54; 65;25;63;161; 1;216;80;73;209;76;132;187;208; 89;18;169;200;196; 135;130;116;188;159;86;164;100;109;198;173;186; 3;64;52;217;226;250;124;123; 5;202;38;147;118;126;255;82;85;212;207;206;59;227;47;16;58;17;182;189;28;42; 223;183;170;213;119;248;152; 2;44;154;163; 70;221;153;101;155;167; 43;172;9; 129;22;39;253; 19;98;108;110;79;113;224;232;178;185; 112;104;218;246;97;228; 251;34;242;193;238;210;144;12;191;179;162;241; 81;51;145;235;249;14;239;107; 49;192;214; 31;181;199;106;157;184; 84;204;176;115;121;50;45;127; 4;150;254; 138;236;205;93;222;114;67;29;24;72;243;141;128;195;78;66;215;61;156;180 |] let private Sqrt3 = 1.7320508075688772935274463415059f let private F2 = 0.5f * (Sqrt3 - 1.0f); let private G2 = (3.0f - Sqrt3) / 6.0f; let inline private dot2 (g : float32[,]) gi x y = g.[gi, 0] * x + g.[gi, 1] * y let sample2 x y = //float n0, n1, n2; // Noise contributions from the three corners // Skew the input space to determine which simplex cell we're in let s = (x + y) * F2; // Hairy factor for 2D //int i = Floor(x + s); //int j = Floor(y + s); let realI = x + s let realJ = y + s let i = int(if realI > 0.0f then realI else realI - 1.0f) let j = int(if realJ > 0.0f then realJ else realJ - 1.0f) let t = float32(i + j) * G2; let X0 = float32(i) - t; // Unskew the cell origin back to (x,y) space let Y0 = float32(j) - t; let x0 = x - X0; // The x,y distances from the cell origin let y0 = y - Y0; // For the 2D case, the simplex shape is an equilateral triangle. // Determine which simplex we are in. //let i1, j1 = // Offsets for second (middle) corner of simplex in (i,j) coords // if (x0 > y0) then 1, 0 // lower triangle, XY order: (0,0)->(1,0)->(1,1) // else 0, 1 // upper triangle, YX order: (0,0)->(0,1)->(1,1) let i1 = if x0 > y0 then 1 else 0 let j1 = 1 - i1 // A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and // a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), where // c = (3-sqrt(3))/6 let x1 = x0 - float32(i1) + G2; // Offsets for middle corner in (x,y) unskewed coords let y1 = y0 - float32(j1) + G2; let x2 = x0 - 1.0f + 2.0f * G2; // Offsets for last corner in (x,y) unskewed coords let y2 = y0 - 1.0f + 2.0f * G2; // Work out the hashed gradient indices of the three simplex corners let ii = i &&& 255; let jj = j &&& 255; //int gi0 = perm.[ii + perm.[jj]] % 12; //int gi1 = perm.[ii + i1 + perm.[jj + j1]] % 12; //int gi2 = perm.[ii + 1 + perm.[jj + 1]] % 12; let gi0 = perm.[ii + perm.[jj]] % 12; let gi1 = perm.[ii + i1 + perm.[jj + j1]] % 12; let gi2 = perm.[ii + 1 + perm.[jj + 1]] % 12; //(n * (n * n * 15731 + 789221) + 1376312589) // Calculate the contribution from the three corners let t0 = 0.5f - x0 * x0 - y0 * y0 let n0 = if (t0 < 0.0f) then 0.0f else let t02 = t0 * t0 t02 * t02 * (dot2 grad3 gi0 x0 y0) // (x,y) of grad3 used for 2D gradient let t1 = 0.5f - x1 * x1 - y1 * y1 let n1 = if (t1 < 0.0f) then 0.0f else let t12 = t1 * t1 t12 * t12 * (dot2 grad3 gi1 x1 y1) let t2 = 0.5f - x2 * x2 - y2 * y2 let n2 = if (t2 < 0.0f) then 0.0f else let t22 = t2 * t2 t22 * t22 * (dot2 grad3 gi2 x2 y2) // Add contributions from each corner to get the final noise value. // The result is scaled to return values in the interval [-1,1]. 70.0f * (n0 + n1 + n2) let private F3 = 1.0f / 3.0f let private G3 = 1.0f / 6.0f; // Very nice and simple unskew factor, too let inline private dot3 (g : float32[,]) gi x y z = g.[gi, 0] * x + g.[gi, 1] * y + g.[gi, 2] * z let inline private floor (x : float32) = if x > 0.0f then int(x) else int(x) - 1 let sample3 x y z = // Skew the input space to determine which simplex cell we're in let s = (x + y + z) * F3 // Very nice and simple skew factor for 3D let i = floor(x + s) let j = floor(y + s) let k = floor(z + s) let t = float32(i + j + k) * G3 let X0 = float32(i) - t // Unskew the cell origin back to (x,y,z) space let Y0 = float32(j) - t let Z0 = float32(k) - t let x0 = x - X0 // The x,y,z distances from the cell origin let y0 = y - Y0 let z0 = z - Z0 // For the 3D case, the simplex shape is a slightly irregular tetrahedron. // Determine which simplex we are in. // Offsets for second corner of simplex in (i,j,k) coords // Offsets for third corner of simplex in (i,j,k) coords let struct(i1, j1, k1, i2, j2, k2) = if (x0 >= y0) then if (y0 >= z0) then 1, 0, 0, 1, 1, 0 // X Y Z order else if (x0 >= z0) then 1, 0, 0, 1, 0, 1 // X Z Y order else 0, 0, 1, 1, 0, 1 // Z X Y order else if (y0 < z0) then 0, 0, 1, 0, 1, 1 // Z Y X order else if (x0 < z0) then 0, 1, 0, 0, 1, 1 // Y Z X order else 0, 1, 0, 1, 1, 0 // Y X Z order // A step of (1,0,0) in (i,j,k) means a step of (1-c,-c,-c) in (x,y,z), // a step of (0,1,0) in (i,j,k) means a step of (-c,1-c,-c) in (x,y,z), and // a step of (0,0,1) in (i,j,k) means a step of (-c,-c,1-c) in (x,y,z), where // c = 1/6. let x1 = x0 - float32(i1) + G3 // Offsets for second corner in (x,y,z) coords let y1 = y0 - float32(j1) + G3 let z1 = z0 - float32(k1) + G3 let x2 = x0 - float32(i2) + 2.0f * G3 // Offsets for third corner in (x,y,z) coords let y2 = y0 - float32(j2) + 2.0f * G3 let z2 = z0 - float32(k2) + 2.0f * G3 let x3 = x0 - 1.0f + 3.0f * G3 // Offsets for last corner in (x,y,z) coords let y3 = y0 - 1.0f + 3.0f * G3 let z3 = z0 - 1.0f + 3.0f * G3 // Work out the hashed gradient indices of the four simplex corners let ii = i &&& 255 let jj = j &&& 255 let kk = k &&& 255 let gi0 = perm.[ii + perm.[jj + perm.[kk]]] % 12 let gi1 = perm.[ii + i1 + perm.[jj + j1 + perm.[kk + k1]]] % 12 let gi2 = perm.[ii + i2 + perm.[jj + j2 + perm.[kk + k2]]] % 12 let gi3 = perm.[ii + 1 + perm.[jj + 1 + perm.[kk + 1]]] % 12 // Calculate the contribution from the four corners let t0 = 0.5f - x0 * x0 - y0 * y0 - z0 * z0 let n0 = if (t0 < 0.0f) then 0.0f else let t02 = t0 * t0 t02 * t02 * (dot3 grad3 gi0 x0 y0 z0) let t1 = 0.6f - x1 * x1 - y1 * y1 - z1 * z1 let n1 = if (t1 < 0.0f) then 0.0f else let t12 = t1 * t1 t12 * t12 * (dot3 grad3 gi1 x1 y1 z1) let t2 = 0.6f - x2 * x2 - y2 * y2 - z2 * z2 let n2 = if (t2 < 0.0f) then 0.0f else let t22 = t2 * t2 t22 * t22 * (dot3 grad3 gi2 x2 y2 z2) let t3 = 0.6f - x3 * x3 - y3 * y3 - z3 * z3 let n3 = if (t3 < 0.0f) then 0.0f else let t32 = t3 * t3 t32 * t32 * (dot3 grad3 gi3 x3 y3 z3) // Add contributions from each corner to get the final noise value. // The result is scaled to stay just inside [-1,1] 32.0f * (n0 + n1 + n2 + n3) let private F4 = 0.309016994f // F4 = (Math.sqrt(5.0)-1.0)/4.0 let private G4 = 0.138196601f // G4 = (5.0-Math.sqrt(5.0))/20.0 let private dot4 (g : float32[,]) gi x y z w = g.[gi, 0] * x + g.[gi, 1] * y + g.[gi, 2] * z + g.[gi, 3] * w let sample4 x y z w = // The skewing and unskewing factors are hairy again for the 4D case //double n0, n1, n2, n3, n4; // Noise contributions from the five corners // Skew the (x,y,z,w) space to determine which cell of 24 simplices we're in let s = (x + y + z + w) * F4; // Factor for 4D skewing let i = floor(x + s); let j = floor(y + s); let k = floor(z + s); let l = floor(w + s); let t = float32(i + j + k + l) * G4; // Factor for 4D unskewing let X0 = float32(i) - t; // Unskew the cell origin back to (x,y,z,w) space let Y0 = float32(j) - t; let Z0 = float32(k) - t; let W0 = float32(l) - t; let x0 = x - X0; // The x,y,z,w distances from the cell origin let y0 = y - Y0; let z0 = z - Z0; let w0 = w - W0; // For the 4D case, the simplex is a 4D shape I won't even try to describe. // To find out which of the 24 possible simplices we're in, we need to // determine the magnitude ordering of x0, y0, z0 and w0. // The method below is a good way of finding the ordering of x,y,z,w and // then find the correct traversal order for the simplex we’re in. // First, six pair-wise comparisons are performed between each possible pair // of the four coordinates, and the results are used to add up binary bits // for an integer index. let c1 = if (x0 > y0) then 32 else 0 let c2 = if (x0 > z0) then 16 else 0 let c3 = if (y0 > z0) then 8 else 0 let c4 = if (x0 > w0) then 4 else 0 let c5 = if (y0 > w0) then 2 else 0 let c6 = if (z0 > w0) then 1 else 0 let c = c1 + c2 + c3 + c4 + c5 + c6; // int i1, j1, k1, l1; // The integer offsets for the second simplex corner // int i2, j2, k2, l2; // The integer offsets for the third simplex corner // int i3, j3, k3, l3; // The integer offsets for the fourth simplex corner // simplex.[c] is a 4-vector with the numbers 0, 1, 2 and 3 in some order. // Many values of c will never occur, since e.g. x>y>z>w makes x= 3 then 1 else 0; let j1 = if simplex.[c, 1] >= 3 then 1 else 0; let k1 = if simplex.[c, 2] >= 3 then 1 else 0; let l1 = if simplex.[c, 3] >= 3 then 1 else 0; // The number 2 in the "simplex" array is at the second largest coordinate. let i2 = if simplex.[c, 0] >= 2 then 1 else 0; let j2 = if simplex.[c, 1] >= 2 then 1 else 0; let k2 = if simplex.[c, 2] >= 2 then 1 else 0; let l2 = if simplex.[c, 3] >= 2 then 1 else 0; // The number 1 in the "simplex" array is at the second smallest coordinate. let i3 = if simplex.[c, 0] >= 1 then 1 else 0; let j3 = if simplex.[c, 1] >= 1 then 1 else 0; let k3 = if simplex.[c, 2] >= 1 then 1 else 0; let l3 = if simplex.[c, 3] >= 1 then 1 else 0; // The fifth corner has all coordinate offsets = 1, so no need to look that up. let x1 = x0 - float32(i1) + G4; // Offsets for second corner in (x,y,z,w) coords let y1 = y0 - float32(j1) + G4; let z1 = z0 - float32(k1) + G4; let w1 = w0 - float32(l1) + G4; let x2 = x0 - float32(i2) + 2.0f * G4; // Offsets for third corner in (x,y,z,w) coords let y2 = y0 - float32(j2) + 2.0f * G4; let z2 = z0 - float32(k2) + 2.0f * G4; let w2 = w0 - float32(l2) + 2.0f * G4; let x3 = x0 - float32(i3) + 3.0f * G4; // Offsets for fourth corner in (x,y,z,w) coords let y3 = y0 - float32(j3) + 3.0f * G4; let z3 = z0 - float32(k3) + 3.0f * G4; let w3 = w0 - float32(l3) + 3.0f * G4; let x4 = x0 - 1.0f + 4.0f * G4; // Offsets for last corner in (x,y,z,w) coords let y4 = y0 - 1.0f + 4.0f * G4; let z4 = z0 - 1.0f + 4.0f * G4; let w4 = w0 - 1.0f + 4.0f * G4; // Work out the hashed gradient indices of the five simplex corners let ii = i &&& 255; let jj = j &&& 255; let kk = k &&& 255; let ll = l &&& 255; let gi0 = perm.[ii + perm.[jj + perm.[kk + perm.[ll]]]] % 32; let gi1 = perm.[ii + i1 + perm.[jj + j1 + perm.[kk + k1 + perm.[ll + l1]]]] % 32; let gi2 = perm.[ii + i2 + perm.[jj + j2 + perm.[kk + k2 + perm.[ll + l2]]]] % 32; let gi3 = perm.[ii + i3 + perm.[jj + j3 + perm.[kk + k3 + perm.[ll + l3]]]] % 32; let gi4 = perm.[ii + 1 + perm.[jj + 1 + perm.[kk + 1 + perm.[ll + 1]]]] % 32; // Calculate the contribution from the five corners let t0 = 0.6f - x0 * x0 - y0 * y0 - z0 * z0 - w0 * w0; let n0 = if (t0 < 0.0f) then 0.0f else let t02 = t0 * t0; t02 * t02 * (dot4 grad4 gi0 x0 y0 z0 w0) let t1 = 0.6f - x1 * x1 - y1 * y1 - z1 * z1 - w1 * w1; let n1 = if (t1 < 0.0f) then 0.0f else let t12 = t1 * t1; t12 * t12 * (dot4 grad4 gi1 x1 y1 z1 w1) let t2 = 0.6f - x2 * x2 - y2 * y2 - z2 * z2 - w2 * w2; let n2 = if (t2 < 0.0f) then 0.0f else let t22 = t2 * t2; t22 * t22 * (dot4 grad4 gi2 x2 y2 z2 w2); let t3 = 0.6f - x3 * x3 - y3 * y3 - z3 * z3 - w3 * w3; let n3 = if (t3 < 0.0f) then 0.0f else let t32 = t3 * t3; t32 * t32 * (dot4 grad4 gi3 x3 y3 z3 w3); let t4 = 0.6f - x4 * x4 - y4 * y4 - z4 * z4 - w4 * w4; let n4 = if (t4 < 0.0f) then 0.0f else let t42 = t4 * t4; t42 * t42 * (dot4 grad4 gi4 x4 y4 z4 w4); // Sum up and scale the result to cover the range [-1,1] 27.0f * (n0 + n1 + n2 + n3 + n4); // This code overlaps a lot with above, but also includes gradient calc module private GradientNoise = let private floor (x : float32) = if x > 0.0f then int(x) else int(x) - 1 // Permutation table. This is just a random jumble of all numbers 0-255, // repeated twice to avoid wrapping the index at 255 for each lookup. let private perm = [| 151;160;137;91;90;15; 131;13;201;95;96;53;194;233;7;225;140;36;103;30;69;142;8;99;37;240;21;10;23; 190; 6;148;247;120;234;75;0;26;197;62;94;252;219;203;117;35;11;32;57;177;33; 88;237;149;56;87;174;20;125;136;171;168; 68;175;74;165;71;134;139;48;27;166; 77;146;158;231;83;111;229;122;60;211;133;230;220;105;92;41;55;46;245;40;244; 102;143;54; 65;25;63;161; 1;216;80;73;209;76;132;187;208; 89;18;169;200;196; 135;130;116;188;159;86;164;100;109;198;173;186; 3;64;52;217;226;250;124;123; 5;202;38;147;118;126;255;82;85;212;207;206;59;227;47;16;58;17;182;189;28;42; 223;183;170;213;119;248;152; 2;44;154;163; 70;221;153;101;155;167; 43;172;9; 129;22;39;253; 19;98;108;110;79;113;224;232;178;185; 112;104;218;246;97;228; 251;34;242;193;238;210;144;12;191;179;162;241; 81;51;145;235;249;14;239;107; 49;192;214; 31;181;199;106;157;184; 84;204;176;115;121;50;45;127; 4;150;254; 138;236;205;93;222;114;67;29;24;72;243;141;128;195;78;66;215;61;156;180; 151;160;137;91;90;15; 131;13;201;95;96;53;194;233;7;225;140;36;103;30;69;142;8;99;37;240;21;10;23; 190; 6;148;247;120;234;75;0;26;197;62;94;252;219;203;117;35;11;32;57;177;33; 88;237;149;56;87;174;20;125;136;171;168; 68;175;74;165;71;134;139;48;27;166; 77;146;158;231;83;111;229;122;60;211;133;230;220;105;92;41;55;46;245;40;244; 102;143;54; 65;25;63;161; 1;216;80;73;209;76;132;187;208; 89;18;169;200;196; 135;130;116;188;159;86;164;100;109;198;173;186; 3;64;52;217;226;250;124;123; 5;202;38;147;118;126;255;82;85;212;207;206;59;227;47;16;58;17;182;189;28;42; 223;183;170;213;119;248;152; 2;44;154;163; 70;221;153;101;155;167; 43;172;9; 129;22;39;253; 19;98;108;110;79;113;224;232;178;185; 112;104;218;246;97;228; 251;34;242;193;238;210;144;12;191;179;162;241; 81;51;145;235;249;14;239;107; 49;192;214; 31;181;199;106;157;184; 84;204;176;115;121;50;45;127; 4;150;254; 138;236;205;93;222;114;67;29;24;72;243;141;128;195;78;66;215;61;156;180 |] // Gradient tables. These could be programmed the Ken Perlin way with // some clever bit-twiddling, but this is more clear, and not really slower. let private grad2lut = [ -1.0f; -1.0f; 1.0f; 0.0f; -1.0f; 0.0f; 1.0f; 1.0f; -1.0f; 1.0f; 0.0f; -1.0f; 0.0f; 1.0f; 1.0f; -1.0f ] // Gradient directions for 3D. // These vectors are based on the midpoints of the 12 edges of a cube. // A larger array of random unit length vectors would also do the job, // but these 12 (including 4 repeats to make the array length a power // of two) work better. They are not random, they are carefully chosen // to represent a small, isotropic set of directions. let private grad3lut = array2D [ [ 1.0f; 0.0f; 1.0f ]; [ 0.0f; 1.0f; 1.0f ]; // 12 cube edges [ -1.0f; 0.0f; 1.0f ]; [ 0.0f; -1.0f; 1.0f ]; [ 1.0f; 0.0f; -1.0f ]; [ 0.0f; 1.0f; -1.0f ]; [ -1.0f; 0.0f; -1.0f ]; [ 0.0f; -1.0f; -1.0f ]; [ 1.0f; -1.0f; 0.0f ]; [ 1.0f; 1.0f; 0.0f ]; [ -1.0f; 1.0f; 0.0f ]; [ -1.0f; -1.0f; 0.0f ]; [ 1.0f; 0.0f; 1.0f ]; [ -1.0f; 0.0f; 1.0f ]; // 4 repeats to make 16 [ 0.0f; 1.0f; -1.0f ]; [ 0.0f; -1.0f; -1.0f ] ] let private grad4lut = array2D [ [ 0.0f; 1.0f; 1.0f; 1.0f ]; [ 0.0f; 1.0f; 1.0f; -1.0f ]; [ 0.0f; 1.0f; -1.0f; 1.0f ]; [ 0.0f; 1.0f; -1.0f; -1.0f ]; // 32 tesseract edges [ 0.0f; -1.0f; 1.0f; 1.0f ]; [ 0.0f; -1.0f; 1.0f; -1.0f ]; [ 0.0f; -1.0f; -1.0f; 1.0f ]; [ 0.0f; -1.0f; -1.0f; -1.0f ]; [ 1.0f; 0.0f; 1.0f; 1.0f ]; [ 1.0f; 0.0f; 1.0f; -1.0f ]; [ 1.0f; 0.0f; -1.0f; 1.0f ]; [ 1.0f; 0.0f; -1.0f; -1.0f ]; [ -1.0f; 0.0f; 1.0f; 1.0f ]; [ -1.0f; 0.0f; 1.0f; -1.0f ]; [ -1.0f; 0.0f; -1.0f; 1.0f ]; [ -1.0f; 0.0f; -1.0f; -1.0f ]; [ 1.0f; 1.0f; 0.0f; 1.0f ]; [ 1.0f; 1.0f; 0.0f; -1.0f ]; [ 1.0f; -1.0f; 0.0f; 1.0f ]; [ 1.0f; -1.0f; 0.0f; -1.0f ]; [ -1.0f; 1.0f; 0.0f; 1.0f ]; [ -1.0f; 1.0f; 0.0f; -1.0f ]; [ -1.0f; -1.0f; 0.0f; 1.0f ]; [ -1.0f; -1.0f; 0.0f; -1.0f ]; [ 1.0f; 1.0f; 1.0f; 0.0f ]; [ 1.0f; 1.0f; -1.0f; 0.0f ]; [ 1.0f; -1.0f; 1.0f; 0.0f ]; [ 1.0f; -1.0f; -1.0f; 0.0f ]; [ -1.0f; 1.0f; 1.0f; 0.0f ]; [ -1.0f; 1.0f; -1.0f; 0.0f ]; [ -1.0f; -1.0f; 1.0f; 0.0f ]; [ -1.0f; -1.0f; -1.0f; 0.0f ] ] // A lookup table to traverse the simplex around a given point in 4D. // Details can be found where this table is used; in the 4D noise method. let private simplex = array2D [ [0;1;2;3];[0;1;3;2];[0;0;0;0];[0;2;3;1];[0;0;0;0];[0;0;0;0];[0;0;0;0];[1;2;3;0]; [0;2;1;3];[0;0;0;0];[0;3;1;2];[0;3;2;1];[0;0;0;0];[0;0;0;0];[0;0;0;0];[1;3;2;0]; [0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0]; [1;2;0;3];[0;0;0;0];[1;3;0;2];[0;0;0;0];[0;0;0;0];[0;0;0;0];[2;3;0;1];[2;3;1;0]; [1;0;2;3];[1;0;3;2];[0;0;0;0];[0;0;0;0];[0;0;0;0];[2;0;3;1];[0;0;0;0];[2;1;3;0]; [0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0];[0;0;0;0]; [2;0;1;3];[0;0;0;0];[0;0;0;0];[0;0;0;0];[3;0;1;2];[3;0;2;1];[0;0;0;0];[3;1;2;0]; [2;1;0;3];[0;0;0;0];[0;0;0;0];[0;0;0;0];[3;1;0;2];[0;0;0;0];[3;2;0;1];[3;2;1;0]]; // Helper functions to compute gradients in 1D to 4D and gradients-dot-residualvectors in 2D to 4D. let private grad1 (hash: int) = let h = hash &&& 15 let gx = 1.0f + float32(h &&& 7) // Gradient value is one of 1.0, 2.0, ..., 8.0 if ((h &&& 8) <> 0) then -gx else gx // Make half of the gradients negative // let grad2 (hash : int) = // let h = hash &&& 7 // grad2lut.[h, 0], grad2lut.[h, 1] let private grad3 (hash : int) = let h = hash &&& 15 grad3lut.[h, 0], grad3lut.[h, 1], grad3lut.[h, 2] let private grad4 (hash : int) = let h = hash &&& 31; grad4lut.[h, 0], grad4lut.[h, 1], grad4lut.[h, 2], grad4lut.[h, 3] // 1D simplex noise with derivative. If the last argument is not null, the analytic derivative is also calculated. let sample1 calcGrad (x : float32) = let i0 = floor(x) let i1 = i0 + 1 let x0 = x - float32(i0) let x1 = x0 - 1.0f let x20 = x0 * x0 let t0 = 1.0f - x20 // if(t0 < 0.0f) t0 = 0.0f; // Never happens for 1D: x0<=1 always let t20 = t0 * t0 let t40 = t20 * t20 let gx0 = grad1(perm.[i0 &&& 0xff]) let n0 = t40 * gx0 * x0 let x21 = x1 * x1 let t1 = 1.0f - x21 // if(t1 < 0.0f) t1 = 0.0f; // Never happens for 1D: |x1|<=1 always let t21 = t1 * t1 let t41 = t21 * t21 let gx1 = grad1(perm.[i1 &&& 0xff]) let n1 = t41 * gx1 * x1 // Compute derivative, if requested by supplying non-null pointer // for the last argument // Compute derivative according to: // *dnoise_dx = -8.0f * t20 * t0 * x0 * (gx0 * x0) + t40 * gx0; // *dnoise_dx += -8.0f * t21 * t1 * x1 * (gx1 * x1) + t41 * gx1; // The maximum value of this noise is 8*(3/4)^4 = 2.53125 // A factor of 0.395 would scale to fit exactly within [-1,1], but // to better match classic Perlin noise, we scale it down some more. let value = 0.25f * (n0 + n1) if calcGrad then let dx0 = t20 * t0 * gx0 * x20 let dx1 = t21 * t1 * gx1 * x21 let dx = (dx0 + dx1) * -8.0f + t40 * gx0 + t41 * gx1 struct(value, dx * 0.25f) // Scale derivative to match the noise scaling else struct(value, 0.0f) // Skewing factors for 2D simplex grid: // F2 = 0.5*(sqrt(3.0)-1.0) // G2 = (3.0-Math.sqrt(3.0))/6.0 let private F2 = 0.366025403f let private G2 = 0.211324865f let private Scaling2 = 40.0f let sample2 calcGrad (x: float32) (y: float32) = // Skew the input space to determine which simplex cell we're in let s = (x + y) * F2; // Hairy factor for 2D let xs = x + s; let ys = y + s; let i = floor(xs); let j = floor(ys); let t = float32(i + j) * G2; let X0 = float32(i) - t; // Unskew the cell origin back to (x,y) space */ let Y0 = float32(j) - t; let x0 = x - X0; // The x,y distances from the cell origin */ let y0 = y - Y0; // For the 2D case, the simplex shape is an equilateral triangle. // Determine which simplex we are in. let i1, j1 = // Offsets for second (middle) corner of simplex in (i,j) coords */ if x0 > y0 then 1, 0 // lower triangle, XY order: (0,0)->(1,0)->(1,1) */ else 0, 1 // upper triangle, YX order: (0,0)->(0,1)->(1,1) */ // A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and // a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), where // c = (3-sqrt(3))/6 let x1 = x0 - float32(i1) + G2; // Offsets for middle corner in (x,y) unskewed coords */ let y1 = y0 - float32(j1) + G2; let x2 = x0 - 1.0f + 2.0f * G2; // Offsets for last corner in (x,y) unskewed coords */ let y2 = y0 - 1.0f + 2.0f * G2; // Wrap the integer indices at 256, to avoid indexing perm.[] out of bounds */ let ii = i &&& 0xff; let jj = j &&& 0xff; // Calculate the contribution from the three corners */ let t0c = 0.5f - x0 * x0 - y0 * y0 let struct(t0, t20, t40, n0, gx0, gy0) = if t0c < 0.0f then struct(0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f) // no influence else let h = (perm.[ii + perm.[jj]] &&& 7) <<< 1 let gx0, gy0 = grad2lut.[h], grad2lut.[h + 1] //let gx0, gy0 = grad2(perm.[ii + perm.[jj]]) let t20 = t0c * t0c let t40 = t20 * t20 let n0 = t40 * (gx0 * x0 + gy0 * y0) struct(t0c, t20, t40, n0, gx0, gy0) let t1c = 0.5f - x1 * x1 - y1 * y1 let struct(t1, t21, t41, n1, gx1, gy1) = if t1c < 0.0f then struct(0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f) // no influence else let h = (perm.[ii + i1 + perm.[jj + j1]] &&& 7) <<< 1 let gx1, gy1 = grad2lut.[h], grad2lut.[h + 1] //let gx1, gy1 = grad2(perm.[ii + i1 + perm.[jj + j1]]) let t21 = t1c * t1c let t41 = t21 * t21 let n1 = t41 * (gx1 * x1 + gy1 * y1) struct(t1c, t21, t41, n1, gx1, gy1) let t2c = 0.5f - x2 * x2 - y2 * y2 let struct(t2, t22, t42, n2, gx2, gy2) = if (t2c < 0.0f) then struct(0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f) // no influence else let h = (perm.[ii + 1 + perm.[jj + 1]] &&& 7) <<< 1 let gx2, gy2 = grad2lut.[h], grad2lut.[h + 1] //let gx2, gy2 = grad2(perm.[ii + 1 + perm.[jj + 1]]) let t22 = t2c * t2c let t42 = t22 * t22 let n2 = t42 * (gx2 * x2 + gy2 * y2) struct(t2c, t22, t42, n2, gx2, gy2) // Add contributions from each corner to get the final noise value. // The result is scaled to return values in the interval [-1,1]. let value = Scaling2 * (n0 + n1 + n2); if calcGrad then // A straight, unoptimised calculation would be like: // *dnoise_dx = -8.0f * t20 * t0 * x0 * ( gx0 * x0 + gy0 * y0 ) + t40 * gx0; // *dnoise_dy = -8.0f * t20 * t0 * y0 * ( gx0 * x0 + gy0 * y0 ) + t40 * gy0; // *dnoise_dx += -8.0f * t21 * t1 * x1 * ( gx1 * x1 + gy1 * y1 ) + t41 * gx1; // *dnoise_dy += -8.0f * t21 * t1 * y1 * ( gx1 * x1 + gy1 * y1 ) + t41 * gy1; // *dnoise_dx += -8.0f * t22 * t2 * x2 * ( gx2 * x2 + gy2 * y2 ) + t42 * gx2; // *dnoise_dy += -8.0f * t22 * t2 * y2 * ( gx2 * x2 + gy2 * y2 ) + t42 * gy2; let temp0 = t20 * t0 * (gx0 * x0 + gy0 * y0); let dnoise_dx = temp0 * x0; let dnoise_dy = temp0 * y0; let temp1 = t21 * t1 * (gx1 * x1 + gy1 * y1); let dnoise_dx1 = dnoise_dx + temp1 * x1; let dnoise_dy1 = dnoise_dy + temp1 * y1; let temp2 = t22 * t2 * (gx2 * x2 + gy2 * y2); let dnoise_dx2 = (dnoise_dx1 + temp2 * x2) * -8.0f + t40 * gx0 + t41 * gx1 + t42 * gx2 let dnoise_dy2 = (dnoise_dy1 + temp2 * y2) * -8.0f + t40 * gy0 + t41 * gy1 + t42 * gy2 struct(value, dnoise_dx2 * Scaling2, dnoise_dy2 * Scaling2) else struct(value, 0.0f, 0.0f) // Skewing factors for 3D simplex grid: // F3 = 1/3 // G3 = 1/6 */ let private F3 = 0.333333333f let private G3 = 0.166666667f let private Scaling3 = 28.0f let sample3 calcGrad (x: float32) (y: float32) (z: float32) = // Skew the input space to determine which simplex cell we're in */ let s = (x + y + z) * F3; // Very nice and simple skew factor for 3D let xs = x + s; let ys = y + s; let zs = z + s; let i = floor(xs); let j = floor(ys); let k = floor(zs); let t = float32(i + j + k) * G3; let X0 = float32(i) - t; // Unskew the cell origin back to (x,y,z) space let Y0 = float32(j) - t; let Z0 = float32(k) - t; let x0 = x - X0; // The x,y,z distances from the cell origin let y0 = y - Y0; let z0 = z - Z0; // For the 3D case, the simplex shape is a slightly irregular tetrahedron. // Determine which simplex we are in. // i1, j1, k1: Offsets for second corner of simplex in (i,j,k) coords */ // i2, j2, k3: Offsets for third corner of simplex in (i,j,k) coords let struct(i1, j1, k1, i2, j2, k2) = if x0 >= y0 then if y0 >= z0 then struct(1, 0, 0, 1, 1, 0) // X Y Z order else if x0 >= z0 then struct(1, 0, 0, 1, 0, 1) // X Z Y order else struct(0, 0, 1, 1, 0, 1) // Z X Y order else // x0 y0) then 32 else 0; let c2 = if (x0 > z0) then 16 else 0; let c3 = if (y0 > z0) then 8 else 0; let c4 = if (x0 > w0) then 4 else 0; let c5 = if (y0 > w0) then 2 else 0; let c6 = if (z0 > w0) then 1 else 0; let c = c1 ||| c2 ||| c3 ||| c4 ||| c5 ||| c6; // '|' is mostly faster than '+' // simplex[c] is a 4-vector with the numbers 0, 1, 2 and 3 in some order. // Many values of c will never occur, since e.g. x>y>z>w makes x= 3 then 1 else 0; let j1 = if simplex.[c, 1] >= 3 then 1 else 0; let k1 = if simplex.[c, 2] >= 3 then 1 else 0; let l1 = if simplex.[c, 3] >= 3 then 1 else 0; // The number 2 in the "simplex" array is at the second largest coordinate. let i2 = if simplex.[c, 0] >= 2 then 1 else 0; let j2 = if simplex.[c, 1] >= 2 then 1 else 0; let k2 = if simplex.[c, 2] >= 2 then 1 else 0; let l2 = if simplex.[c, 3] >= 2 then 1 else 0; // The number 1 in the "simplex" array is at the second smallest coordinate. let i3 = if simplex.[c, 0] >= 1 then 1 else 0; let j3 = if simplex.[c, 1] >= 1 then 1 else 0; let k3 = if simplex.[c, 2] >= 1 then 1 else 0; let l3 = if simplex.[c, 3] >= 1 then 1 else 0; // The fifth corner has all coordinate offsets = 1, so no need to look that up. let x1 = x0 - float32(i1) + G4; // Offsets for second corner in (x,y,z,w) coords let y1 = y0 - float32(j1) + G4; let z1 = z0 - float32(k1) + G4; let w1 = w0 - float32(l1) + G4; let x2 = x0 - float32(i2) + 2.0f * G4; // Offsets for third corner in (x,y,z,w) coords let y2 = y0 - float32(j2) + 2.0f * G4; let z2 = z0 - float32(k2) + 2.0f * G4; let w2 = w0 - float32(l2) + 2.0f * G4; let x3 = x0 - float32(i3) + 3.0f * G4; // Offsets for fourth corner in (x,y,z,w) coords let y3 = y0 - float32(j3) + 3.0f * G4; let z3 = z0 - float32(k3) + 3.0f * G4; let w3 = w0 - float32(l3) + 3.0f * G4; let x4 = x0 - 1.0f + 4.0f * G4; // Offsets for last corner in (x,y,z,w) coords let y4 = y0 - 1.0f + 4.0f * G4; let z4 = z0 - 1.0f + 4.0f * G4; let w4 = w0 - 1.0f + 4.0f * G4; // Wrap the integer indices at 256, to avoid indexing perm.[] out of bounds let ii = i &&& 0xff; let jj = j &&& 0xff; let kk = k &&& 0xff; let ll = l &&& 0xff; // Calculate the contribution from the five corners let t0c = 0.6f - x0 * x0 - y0 * y0 - z0 * z0 - w0 * w0; let struct(n0, t0, t20, t40, gx0, gy0, gz0, gw0) = if (t0c < 0.0f) then 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f // no influence else let t20 = t0c * t0c; let t40 = t20 * t20; let gx0, gy0, gz0, gw0 = grad4(perm.[ii + perm.[jj + perm.[kk + perm.[ll]]]]); let n0 = t40 * (gx0 * x0 + gy0 * y0 + gz0 * z0 + gw0 * w0); struct(n0, t0c, t20, t40, gx0, gy0, gz0, gw0) let t1c = 0.6f - x1 * x1 - y1 * y1 - z1 * z1 - w1 * w1; let struct(n1, t1, t21, t41, gx1, gy1, gz1, gw1) = if (t1c < 0.0f) then 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f // no influence else let t21 = t1c * t1c; let t41 = t21 * t21; let gx1, gy1, gz1, gw1 = grad4(perm.[ii + i1 + perm.[jj + j1 + perm.[kk + k1 + perm.[ll + l1]]]]); let n1 = t41 * (gx1 * x1 + gy1 * y1 + gz1 * z1 + gw1 * w1); struct(n1, t1c, t21, t41, gx1, gy1, gz1, gw1) let t2c = 0.6f - x2 * x2 - y2 * y2 - z2 * z2 - w2 * w2; let struct(n2, t2, t22, t42, gx2, gy2, gz2, gw2) = if (t2c < 0.0f) then 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f // no influence else let t22 = t2c * t2c; let t42 = t22 * t22; let gx2, gy2, gz2, gw2 = grad4(perm.[ii + i2 + perm.[jj + j2 + perm.[kk + k2 + perm.[ll + l2]]]]); let n2 = t42 * (gx2 * x2 + gy2 * y2 + gz2 * z2 + gw2 * w2); struct(n2, t2c, t22, t42, gx2, gy2, gz2, gw2) let t3c = 0.6f - x3 * x3 - y3 * y3 - z3 * z3 - w3 * w3; let struct(n3, t3, t23, t43, gx3, gy3, gz3, gw3) = if (t3c < 0.0f) then 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f // no influence else let t23 = t3c * t3c; let t43 = t23 * t23; let gx3, gy3, gz3, gw3 = grad4(perm.[ii + i3 + perm.[jj + j3 + perm.[kk + k3 + perm.[ll + l3]]]]); let n3 = t43 * (gx3 * x3 + gy3 * y3 + gz3 * z3 + gw3 * w3); struct(n3, t3c, t23, t43, gx3, gy3, gz3, gw3) let t4c = 0.6f - x4 * x4 - y4 * y4 - z4 * z4 - w4 * w4; let struct(n4, t4, t24, t44, gx4, gy4, gz4, gw4) = if (t4c < 0.0f) then 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f // no influence else let t24 = t4c * t4c; let t44 = t24 * t24; let gx4, gy4, gz4, gw4 = grad4(perm.[ii + 1 + perm.[jj + 1 + perm.[kk + 1 + perm.[ll + 1]]]]); let n4 = t44 * (gx4 * x4 + gy4 * y4 + gz4 * z4 + gw4 * w4); struct(n4, t4c, t24, t44, gx4, gy4, gz4, gw4) // Sum up and scale the result to cover the range [-1,1] let value = 27.0f * (n0 + n1 + n2 + n3 + n4); // The scale factor is preliminary! // Compute derivative, if requested by supplying non-null pointers // for the last four arguments */ //if( ( NULL != dnoise_dx ) && ( NULL != dnoise_dy ) && ( NULL != dnoise_dz ) && ( NULL != dnoise_dw ) ) if calcGrad then // A straight, unoptimised calculation would be like: //* *dnoise_dx = -8.0f * t20 * t0 * x0 * dot(gx0, gy0, gz0, gw0, x0, y0, z0, w0) + t40 * gx0; //* *dnoise_dy = -8.0f * t20 * t0 * y0 * dot(gx0, gy0, gz0, gw0, x0, y0, z0, w0) + t40 * gy0; //* *dnoise_dz = -8.0f * t20 * t0 * z0 * dot(gx0, gy0, gz0, gw0, x0, y0, z0, w0) + t40 * gz0; //* *dnoise_dw = -8.0f * t20 * t0 * w0 * dot(gx0, gy0, gz0, gw0, x0, y0, z0, w0) + t40 * gw0; //* *dnoise_dx += -8.0f * t21 * t1 * x1 * dot(gx1, gy1, gz1, gw1, x1, y1, z1, w1) + t41 * gx1; //* *dnoise_dy += -8.0f * t21 * t1 * y1 * dot(gx1, gy1, gz1, gw1, x1, y1, z1, w1) + t41 * gy1; //* *dnoise_dz += -8.0f * t21 * t1 * z1 * dot(gx1, gy1, gz1, gw1, x1, y1, z1, w1) + t41 * gz1; //* *dnoise_dw = -8.0f * t21 * t1 * w1 * dot(gx1, gy1, gz1, gw1, x1, y1, z1, w1) + t41 * gw1; //* *dnoise_dx += -8.0f * t22 * t2 * x2 * dot(gx2, gy2, gz2, gw2, x2, y2, z2, w2) + t42 * gx2; //* *dnoise_dy += -8.0f * t22 * t2 * y2 * dot(gx2, gy2, gz2, gw2, x2, y2, z2, w2) + t42 * gy2; //* *dnoise_dz += -8.0f * t22 * t2 * z2 * dot(gx2, gy2, gz2, gw2, x2, y2, z2, w2) + t42 * gz2; //* *dnoise_dw += -8.0f * t22 * t2 * w2 * dot(gx2, gy2, gz2, gw2, x2, y2, z2, w2) + t42 * gw2; //* *dnoise_dx += -8.0f * t23 * t3 * x3 * dot(gx3, gy3, gz3, gw3, x3, y3, z3, w3) + t43 * gx3; //* *dnoise_dy += -8.0f * t23 * t3 * y3 * dot(gx3, gy3, gz3, gw3, x3, y3, z3, w3) + t43 * gy3; //* *dnoise_dz += -8.0f * t23 * t3 * z3 * dot(gx3, gy3, gz3, gw3, x3, y3, z3, w3) + t43 * gz3; //* *dnoise_dw += -8.0f * t23 * t3 * w3 * dot(gx3, gy3, gz3, gw3, x3, y3, z3, w3) + t43 * gw3; //* *dnoise_dx += -8.0f * t24 * t4 * x4 * dot(gx4, gy4, gz4, gw4, x4, y4, z4, w4) + t44 * gx4; //* *dnoise_dy += -8.0f * t24 * t4 * y4 * dot(gx4, gy4, gz4, gw4, x4, y4, z4, w4) + t44 * gy4; //* *dnoise_dz += -8.0f * t24 * t4 * z4 * dot(gx4, gy4, gz4, gw4, x4, y4, z4, w4) + t44 * gz4; //* *dnoise_dw += -8.0f * t24 * t4 * w4 * dot(gx4, gy4, gz4, gw4, x4, y4, z4, w4) + t44 * gw4; //*/ let temp0 = t20 * t0 * (gx0 * x0 + gy0 * y0 + gz0 * z0 + gw0 * w0); let dnoise_dx = temp0 * x0; let dnoise_dy = temp0 * y0; let dnoise_dz = temp0 * z0; let dnoise_dw = temp0 * w0; let temp1 = t21 * t1 * (gx1 * x1 + gy1 * y1 + gz1 * z1 + gw1 * w1); let dnoise_dx1 = dnoise_dx + temp1 * x1; let dnoise_dy1 = dnoise_dy + temp1 * y1; let dnoise_dz1 = dnoise_dz + temp1 * z1; let dnoise_dw1 = dnoise_dw + temp1 * w1; let temp2 = t22 * t2 * (gx2 * x2 + gy2 * y2 + gz2 * z2 + gw2 * w2); let dnoise_dx2 = dnoise_dx1 + temp2 * x2; let dnoise_dy2 = dnoise_dy1 + temp2 * y2; let dnoise_dz2 = dnoise_dz1 + temp2 * z2; let dnoise_dw2 = dnoise_dw1 + temp2 * w2; let temp3 = t23 * t3 * (gx3 * x3 + gy3 * y3 + gz3 * z3 + gw3 * w3); let dnoise_dx3 = dnoise_dx2 + temp3 * x3; let dnoise_dy3 = dnoise_dy2 + temp3 * y3; let dnoise_dz3 = dnoise_dz2 + temp3 * z3; let dnoise_dw3 = dnoise_dw2 + temp3 * w3; let temp4 = t24 * t4 * (gx4 * x4 + gy4 * y4 + gz4 * z4 + gw4 * w4); let dnoise_dx4 = dnoise_dx3 + temp4 * x4; let dnoise_dy4 = dnoise_dy3 + temp4 * y4; let dnoise_dz4 = dnoise_dz3 + temp4 * z4; let dnoise_dw4 = dnoise_dw3 + temp4 * w4; let dnoise_dx5 = dnoise_dx4 * -8.0f + t40 * gx0 + t41 * gx1 + t42 * gx2 + t43 * gx3 + t44 * gx4; let dnoise_dy5 = dnoise_dy4 * -8.0f + t40 * gy0 + t41 * gy1 + t42 * gy2 + t43 * gy3 + t44 * gy4; let dnoise_dz5 = dnoise_dz4 * -8.0f + t40 * gz0 + t41 * gz1 + t42 * gz2 + t43 * gz3 + t44 * gz4; let dnoise_dw5 = dnoise_dw4 * -8.0f + t40 * gw0 + t41 * gw1 + t42 * gw2 + t43 * gw3 + t44 * gw4; struct(value, dnoise_dx5 * 28.0f, dnoise_dy5 * 28.0f, dnoise_dz5 * 28.0f, dnoise_dw5 * 28.0f) else struct(value, 0.0f, 0.0f, 0.0f, 0.0f) type Noise() = static member Sample(x) = let struct(s, _) = GradientNoise.sample1 false x s static member Sample(p : Vector2) = SimplexNoise.sample2 p.X p.Y static member Sample(p : Vector3) = SimplexNoise.sample3 p.X p.Y p.Z static member Sample(p : Vector4) = SimplexNoise.sample4 p.X p.Y p.Z p.W ================================================ FILE: samples/Garnet.Numerics/Numerics.fs ================================================ namespace Garnet.Numerics open System open System.Numerics [] module MathF = type MathF with static member inline Lerp(min, max, t : float32) = min * (1.0f - t) + max * t static member inline Clamp(s0 : float32, s1 : float32, s : float32) = s |> max s0 |> min s1 static member inline Clamp01(x) = MathF.Clamp(0.0f, 1.0f, x) static member inline LinearStep(s0, s1, s) = let length = s1 - s0 if abs length < 1e-7f then 0.0f else MathF.Clamp01((s - s0) / length) static member inline SmoothStep(s0, s1, s) = let x = MathF.LinearStep(s0, s1, s) x * x * (3.0f - 2.0f * x) [] module Matrix4x4 = type Matrix4x4 with member m.GetInverseOrIdentity() = let mutable mInv = Matrix4x4.Identity if Matrix4x4.Invert(m, &mInv) then mInv else Matrix4x4.Identity ================================================ FILE: samples/Garnet.Numerics/Random.fs ================================================ namespace Garnet.Numerics open System open System.Numerics type PcgRandom(initState, initSeq) = let inc = PcgRandom.GetIncrement(initSeq) let mutable state = PcgRandom.GetState(initState, inc) new() = PcgRandom(0x853c49e6748fea9bUL, 0xda3e39cb94b95bdbUL) member c.NextUInt32() = let result = PcgRandom.GetUInt32(state) state <- PcgRandom.GetNextState(state, inc) result static member GetUInt32(state) = let xorShifted = uint32 (((state >>> 18) ^^^ state) >>> 27) let rot = int (state >>> 59) (xorShifted >>> rot) ||| (xorShifted <<< ((-rot) &&& 31)) static member GetNextState(state, inc) = state * 6364136223846793005UL + inc static member GetIncrement(initSeq) = (initSeq <<< 1) ||| 1UL static member GetState(seed, inc) = let s = PcgRandom.GetNextState(0UL, inc) + seed PcgRandom.GetNextState(s, inc) type PcgRandom with member c.NextInt32() = c.NextUInt32() |> int member c.NextUInt32Unbiased(exclusiveBound : uint) = let threshold = uint32 ((0x100000000UL - uint64 exclusiveBound) % uint64 exclusiveBound) let mutable r = c.NextUInt32() while r < threshold do r <- c.NextUInt32() r % exclusiveBound member c.NextInt32Unbiased(exclusiveBound : int) = let threshold = int32 ((0x100000000UL - uint64 exclusiveBound) % uint64 exclusiveBound) let mutable r = c.NextInt32() while r < threshold do r <- c.NextInt32() r % exclusiveBound member c.NextInt32(max : int) = if max = 0 then 0 else c.NextUInt32() % (uint32 max) |> int member c.NextUInt32(max : uint) = if max = 0u then 0u else c.NextUInt32() % max member c.NextUInt32(min, max) = c.NextUInt32(max - min) + min member c.NextInt32(min, max) = c.NextInt32(max - min) + min /// Closed [0, 1] member c.NextDouble() = let x = c.NextUInt32() double x * (1.0 / 4294967295.0) /// Half open [0, 1) member c.NextDouble2() = let x = c.NextUInt32() double x * (1.0 / 4294967296.0) /// Open (0, 1) member c.NextDouble3() = let x = c.NextUInt32() (double x + 0.5) * (1.0 / 4294967296.0) member c.NextSingle() = float32 (c.NextDouble()) member c.NextSingle2() = float32 (c.NextDouble2()) member c.NextSingle3() = float32 (c.NextDouble3()) member c.NextSingle(min, max) = c.NextSingle() * (max - min) + min member c.NextRotation(radiansRange) = Vector2.FromRadians((c.NextSingle() - 0.5f) * radiansRange) member c.NextRotationDegrees(degreesRange) = c.NextRotation(degreesRange * MathF.PI / 180.0f) member c.NextVector2() = Vector2(c.NextSingle(), c.NextSingle()) member c.NextVector2(range : Range2) = Range2.Lerp(range, c.NextVector2()) member c.NextVector3() = Vector3(c.NextSingle(), c.NextSingle(), c.NextSingle()) member c.NextVector3(range : Range3) = Range3.Lerp(range, c.NextVector3()) member c.NextVector2i(r : Range2i) = Vector2i( c.NextInt32(r.Min.X, r.Max.X), c.NextInt32(r.Min.Y, r.Max.Y)) member c.NextVector2i(min, max) = let r = Rangei(min, max) c.NextVector2i(Range2i(r, r)) member c.NextVector3i(r : Range3i) = Vector3i( c.NextInt32(r.Min.X, r.Max.X), c.NextInt32(r.Min.Y, r.Max.Y), c.NextInt32(r.Min.Z, r.Max.Z)) member c.NextVector3i(min, max) = let r = Rangei(min, max) c.NextVector3i(Range3i(r, r, r)) member c.Next(dest : Span) = for i = 0 to dest.Length - 1 do dest.[i] <- c.NextInt32() member c.Shuffle(items) = let r = items |> Seq.toArray for i = 0 to r.Length - 2 do let j = c.NextInt32(i, r.Length) let temp = r.[i] r.[i] <- r.[j] r.[j] <- temp r ================================================ FILE: samples/Garnet.Numerics/Ranges.fs ================================================ namespace Garnet.Numerics open System.Numerics // Float range types [] type Range = val Min : float32 val Max : float32 new(min, max) = { Min = min; Max = max } member inline c.Size = c.Max - c.Min member inline c.IsEmpty = c.Min >= c.Max member inline c.Contains(x) = x >= c.Min && x < c.Max member inline c.Expand(margin) = Range(c.Min - margin, c.Max + margin) member inline c.Clamp(x) = x |> max c.Min |> min c.Max override v.ToString() = $"%A{v.Min} to %A{v.Max}" static member Zero = Range(0.0f, 0.0f) static member ZeroToOne = Range(0.0f, 1.0f) static member inline Lerp(r : Range, t) = r.Min * (1.0f - t) + r.Max * t static member inline (+) (a: Range, c) = Range(a.Min + c, a.Max + c) static member inline (-) (a: Range, c) = Range(a.Min - c, a.Max - c) static member inline (*) (a: Range, c) = Range(a.Min * c, a.Max * c) static member inline (/) (a: Range, c) = Range(a.Min / c, a.Max / c) static member inline Point(point) = Range(point, point) static member inline Sized(min, size) = Range(min, min + size) static member inline Centered(center, size) = Range.Sized(center - size * 0.5f, size) static member inline Intersection(a : Range, b : Range) = Range(max a.Min b.Min, min a.Max b.Max) static member inline Union(a : Range, b : Range) = Range(min a.Min b.Min, max a.Max b.Max) [] type Range2 = val Min : Vector2 val Max : Vector2 new(min, max) = { Min = min; Max = max } new(x : Range, y : Range) = { Min = Vector2(x.Min, y.Min) Max = Vector2(x.Max, y.Max) } member inline c.X = Range(c.Min.X, c.Max.X) member inline c.Y = Range(c.Min.Y, c.Max.Y) member inline c.Center = (c.Min + c.Max) * 0.5f member inline c.Size = c.Max - c.Min member inline c.GetArea() = let s = c.Size s.X * s.Y member inline c.Contains(p : Vector2) = c.X.Contains p.X && c.Y.Contains p.Y member inline c.Expand(margin : Vector2) = Range2( c.X.Expand(margin.X), c.Y.Expand(margin.Y)) override i.ToString() = $"%A{i.Min} to %A{i.Max}" static member Zero = Range2(Vector2.Zero, Vector2.Zero) static member ZeroToOne = Range2(Vector2.Zero, Vector2.One) static member inline Lerp(r : Range2, t : Vector2) = Vector2( Range.Lerp(r.X, t.X), Range.Lerp(r.Y, t.Y)) static member inline (+) (a: Range2, c : float32) = Range2(a.X + c, a.Y + c) static member inline (-) (a: Range2, c : float32) = Range2(a.X - c, a.Y - c) static member inline (*) (a: Range2, c : float32) = Range2(a.X * c, a.Y * c) static member inline (/) (a: Range2, c : float32) = Range2(a.X / c, a.Y / c) static member inline (+) (a: Range2, v : Vector2) = Range2(a.X + v.X, a.Y + v.Y) static member inline (-) (a: Range2, v : Vector2) = Range2(a.X - v.X, a.Y - v.Y) static member inline (*) (a: Range2, v : Vector2) = Range2(a.X * v.X, a.Y * v.Y) static member inline (/) (a: Range2, v : Vector2) = Range2(a.X / v.X, a.Y / v.Y) static member inline Point(point : Vector2) = Range2(point, point) static member inline Sized(min : Vector2, size : Vector2) = Range2(min, min + size) static member inline Centered(center : Vector2, size : Vector2) = Range2.Sized(center - size * 0.5f, size) static member inline Intersection(a : Range2, b : Range2) = Range2( Range.Intersection(a.X, b.X), Range.Intersection(a.Y, b.Y)) static member inline Union(a : Range2, b : Range2) = Range2( Range.Union(a.X, b.X), Range.Union(a.Y, b.Y)) [] type Range3 = val Min : Vector3 val Max : Vector3 new(min, max) = { Min = min; Max = max } new(x : Range, y : Range, z : Range) = { Min = Vector3(x.Min, y.Min, z.Min) Max = Vector3(x.Max, y.Max, z.Max) } member inline c.X = Range(c.Min.X, c.Max.X) member inline c.Y = Range(c.Min.Y, c.Max.Y) member inline c.Z = Range(c.Min.Z, c.Max.Z) member inline c.Size = c.Max - c.Min member inline c.GetVolume() = let s = c.Size s.X * s.Y * s.Z member inline c.Contains(p : Vector3) = c.X.Contains p.X && c.Y.Contains p.Y && c.Z.Contains p.Z member inline c.Expand(margin : Vector3) = Range3( c.X.Expand(margin.X), c.Y.Expand(margin.Y), c.Z.Expand(margin.Z)) member inline c.Clamp(p : Vector3) = Vector3( c.X.Clamp p.X, c.Y.Clamp p.Y, c.Z.Clamp p.Z) override i.ToString() = $"%A{i.Min} to %A{i.Max}" static member inline Lerp(r : Range3, t : Vector3) = Vector3( Range.Lerp(r.X, t.X), Range.Lerp(r.Y, t.Y), Range.Lerp(r.Z, t.Z)) static member Zero = Range3(Vector3.Zero, Vector3.Zero) static member ZeroToOne = Range3(Vector3.Zero, Vector3.One) static member inline (+) (a: Range3, c) = Range3(a.X + c, a.Y + c, a.Z + c) static member inline (-) (a: Range3, c) = Range3(a.X - c, a.Y - c, a.Z - c) static member inline (*) (a: Range3, c) = Range3(a.X * c, a.Y * c, a.Z * c) static member inline (/) (a: Range3, c) = Range3(a.X / c, a.Y / c, a.Z / c) static member inline (+) (a: Range3, v : Vector3) = Range3(a.X + v.X, a.Y + v.Y, a.Z + v.Z) static member inline (-) (a: Range3, v : Vector3) = Range3(a.X - v.X, a.Y - v.Y, a.Z - v.Z) static member inline (*) (a: Range3, v : Vector3) = Range3(a.X * v.X, a.Y * v.Y, a.Z * v.Z) static member inline (/) (a: Range3, v : Vector3) = Range3(a.X / v.X, a.Y / v.Y, a.Z / v.Z) static member inline Point(point : Vector3) = Range3(point, point) static member inline Sized(min : Vector3, size : Vector3) = Range3(min, min + size) static member inline Centered(center : Vector3, size : Vector3) = Range3.Sized(center - size * 0.5f, size) static member inline Intersection(a : Range3, b : Range3) = Range3( Range.Intersection(a.X, b.X), Range.Intersection(a.Y, b.Y), Range.Intersection(a.Z, b.Z)) static member inline Union(a : Range3, b : Range3) = Range3( Range.Union(a.X, b.X), Range.Union(a.Y, b.Y), Range.Union(a.Z, b.Z)) // Int32 range types [] type Rangei = val Min : int val Max : int new(min, max) = { Min = min; Max = max } member inline c.Size = c.Max - c.Min member inline c.IsEmpty = c.Min >= c.Max member inline c.Contains(x) = x >= c.Min && x < c.Max member inline c.Expand(margin) = Rangei(c.Min - margin, c.Max + margin) member inline c.Clamp(x) = x |> max c.Min |> min c.Max member inline c.ToRange() = Range(float32 c.Min, float32 c.Max) override v.ToString() = $"%A{v.Min} to %A{v.Max}" static member Zero = Rangei(0, 0) static member ZeroToOne = Rangei(0, 1) static member inline (+) (a: Rangei, c) = Rangei(a.Min + c, a.Max + c) static member inline (-) (a: Rangei, c) = Rangei(a.Min - c, a.Max - c) static member inline (*) (a: Rangei, c) = Rangei(a.Min * c, a.Max * c) static member inline (/) (a: Rangei, c) = Rangei(a.Min / c, a.Max / c) static member inline Point(point) = Rangei(point, point) static member inline Sized(min, size) = Rangei(min, min + size) static member inline Centered(center, size) = Rangei.Sized(center - size / 2, size) static member inline Intersection(a : Rangei, b : Rangei) = Rangei(max a.Min b.Min, min a.Max b.Max) static member inline Union(a : Rangei, b : Rangei) = Rangei(min a.Min b.Min, max a.Max b.Max) [] type Range2i = val Min : Vector2i val Max : Vector2i new(min, max) = { Min = min; Max = max } new(x : Rangei, y : Rangei) = { Min = Vector2i(x.Min, y.Min) Max = Vector2i(x.Max, y.Max) } member inline c.X = Rangei(c.Min.X, c.Max.X) member inline c.Y = Rangei(c.Min.Y, c.Max.Y) member inline c.Size = c.Max - c.Min member inline c.IsEmpty = c.X.IsEmpty || c.Y.IsEmpty member inline c.ToRange2() = Range2(c.Min.ToVector2(), c.Max.ToVector2()) member inline c.GetArea() = let s = c.Size s.X * s.Y member inline c.Contains (p : Vector2i) = c.X.Contains p.X && c.Y.Contains p.Y member inline c.Expand(margin : Vector2i) = Range2i( c.X.Expand(margin.X), c.Y.Expand(margin.Y)) member inline c.Clamp(p : Vector2i) = Vector2i(c.X.Clamp p.X, c.Y.Clamp p.Y) override i.ToString() = $"%A{i.Min} to %A{i.Max}" static member Zero = Range2i(Vector2i.Zero, Vector2i.Zero) static member ZeroToOne = Range2i(Vector2i.Zero, Vector2i.One) static member inline (+) (a: Range2i, c) = Range2i(a.X + c, a.Y + c) static member inline (-) (a: Range2i, c) = Range2i(a.X - c, a.Y - c) static member inline (*) (a: Range2i, c) = Range2i(a.X * c, a.Y * c) static member inline (/) (a: Range2i, c) = Range2i(a.X / c, a.Y / c) static member inline (+) (a: Range2i, v : Vector2i) = Range2i(a.X + v.X, a.Y + v.Y) static member inline (-) (a: Range2i, v : Vector2i) = Range2i(a.X - v.X, a.Y - v.Y) static member inline (*) (a: Range2i, v : Vector2i) = Range2i(a.X * v.X, a.Y * v.Y) static member inline (/) (a: Range2i, v : Vector2i) = Range2i(a.X / v.X, a.Y / v.Y) static member inline Point(point : Vector2i) = Range2i(point, point) static member inline Sized(min : Vector2i, size : Vector2i) = Range2i(min, min + size) static member inline Centered(center : Vector2i, size : Vector2i) = Range2i.Sized(center - size / 2, size) static member inline Intersection(a : Range2i, b : Range2i) = Range2i( Rangei.Intersection(a.X, b.X), Rangei.Intersection(a.Y, b.Y)) static member inline Union(a : Range2i, b : Range2i) = Range2i( Rangei.Union(a.X, b.X), Rangei.Union(a.Y, b.Y)) [] type Range3i = val Min : Vector3i val Max : Vector3i new(min, max) = { Min = min; Max = max } new(x : Rangei, y : Rangei, z : Rangei) = { Min = Vector3i(x.Min, y.Min, z.Min) Max = Vector3i(x.Max, y.Max, z.Max) } member inline c.X = Rangei(c.Min.X, c.Max.X) member inline c.Y = Rangei(c.Min.Y, c.Max.Y) member inline c.Z = Rangei(c.Min.Z, c.Max.Z) member inline c.Size = c.Max - c.Min member inline c.IsEmpty = c.X.IsEmpty || c.Y.IsEmpty || c.Z.IsEmpty member inline c.ToRange3() = Range3(c.Min.ToVector3(), c.Max.ToVector3()) member inline c.GetVolume() = let s = c.Size s.X * s.Y * s.Z member inline c.Contains(p : Vector3i) = c.X.Contains p.X && c.Y.Contains p.Y && c.Z.Contains p.Z member inline c.Expand(margin : Vector3i) = Range3i( c.X.Expand(margin.X), c.Y.Expand(margin.Y), c.Z.Expand(margin.Z)) member inline c.Clamp(p : Vector3i) = Vector3i( c.X.Clamp p.X, c.Y.Clamp p.Y, c.Z.Clamp p.Z) override i.ToString() = $"%A{i.Min} to %A{i.Max}" static member Zero = Range3i(Vector3i.Zero, Vector3i.Zero) static member ZeroToOne = Range3i(Vector3i.Zero, Vector3i.One) static member inline (+) (a: Range3i, c) = Range3i(a.X + c, a.Y + c, a.Z + c) static member inline (-) (a: Range3i, c) = Range3i(a.X - c, a.Y - c, a.Z - c) static member inline (*) (a: Range3i, c) = Range3i(a.X * c, a.Y * c, a.Z * c) static member inline (/) (a: Range3i, c) = Range3i(a.X / c, a.Y / c, a.Z / c) static member inline (+) (a: Range3i, v : Vector3i) = Range3i(a.X + v.X, a.Y + v.Y, a.Z + v.Z) static member inline (-) (a: Range3i, v : Vector3i) = Range3i(a.X - v.X, a.Y - v.Y, a.Z - v.Z) static member inline (*) (a: Range3i, v : Vector3i) = Range3i(a.X * v.X, a.Y * v.Y, a.Z * v.Z) static member inline (/) (a: Range3i, v : Vector3i) = Range3i(a.X / v.X, a.Y / v.Y, a.Z / v.Z) static member inline Point(point : Vector3i) = Range3i(point, point) static member inline Sized(min : Vector3i, size : Vector3i) = Range3i(min, min + size) static member inline Centered(center : Vector3i, size : Vector3i) = Range3i.Sized(center - size / 2, size) static member inline Intersection(a : Range3i, b : Range3i) = Range3i( Rangei.Intersection(a.X, b.X), Rangei.Intersection(a.Y, b.Y), Rangei.Intersection(a.Z, b.Z)) static member inline Union(a : Range3i, b : Range3i) = Range3i( Rangei.Union(a.X, b.X), Rangei.Union(a.Y, b.Y), Rangei.Union(a.Z, b.Z)) ================================================ FILE: samples/Garnet.Numerics/Vectors.fs ================================================ namespace Garnet.Numerics open System open System.Numerics // Int32 vector types [] type Vector2i = val X : int val Y : int new(x, y) = { X = x; Y = y } member c.ToVector2() = Vector2(float32 c.X, float32 c.Y) override v.ToString() = $"%A{v.X} %A{v.Y}" static member Zero = Vector2i(0, 0) static member One = Vector2i(1, 1) static member UnitX = Vector2i(1, 0) static member UnitY = Vector2i(0, 1) static member inline Dot(a: Vector2i, b: Vector2i) = a.X * b.X + a.Y * b.Y static member inline (~-) (v: Vector2i) = Vector2i(-v.X, -v.Y) static member inline (+) (a: Vector2i, c) = Vector2i(a.X + c, a.Y + c) static member inline (-) (a: Vector2i, c) = Vector2i(a.X - c, a.Y - c) static member inline (*) (a: Vector2i, c) = Vector2i(a.X * c, a.Y * c) static member inline (/) (a: Vector2i, c) = Vector2i(a.X / c, a.Y / c) static member inline (>>>) (a: Vector2i, c) = Vector2i(a.X >>> c, a.Y >>> c) static member inline (<<<) (a: Vector2i, c) = Vector2i(a.X <<< c, a.Y <<< c) static member inline (&&&) (a: Vector2i, c) = Vector2i(a.X &&& c, a.Y &&& c) static member inline (+) (a: Vector2i, b: Vector2i) = Vector2i(a.X + b.X, a.Y + b.Y) static member inline (-) (a: Vector2i, b: Vector2i) = Vector2i(a.X - b.X, a.Y - b.Y) static member inline (*) (a: Vector2i, b: Vector2i) = Vector2i(a.X * b.X, a.Y * b.Y) static member inline (/) (a: Vector2i, b: Vector2i) = Vector2i(a.X / b.X, a.Y / b.Y) static member inline Perpendicular(v : Vector2i) = Vector2i(-v.Y, v.X) static member inline FromVector2(v : Vector2) = Vector2i(int v.X, int v.Y) [] type Vector3i = val X : int val Y : int val Z : int new(x, y, z) = { X = x; Y = y; Z = z } member c.ToVector3() = Vector3(float32 c.X, float32 c.Y, float32 c.Z) override v.ToString() = $"%A{v.X} %A{v.Y} %A{v.Z}" static member Zero = Vector3i(0, 0, 0) static member One = Vector3i(1, 1, 1) static member UnitX = Vector3i(1, 0, 0) static member UnitY = Vector3i(0, 1, 0) static member UnitZ = Vector3i(0, 0, 1) static member inline Dot(a: Vector3i, b: Vector3i) = a.X * b.X + a.Y * b.Y + a.Z * b.Z static member inline (~-) (v: Vector3i) = Vector3i(-v.X, -v.Y, -v.Z) static member inline (+) (a: Vector3i, c) = Vector3i(a.X + c, a.Y + c, a.Z + c) static member inline (-) (a: Vector3i, c) = Vector3i(a.X - c, a.Y - c, a.Z - c) static member inline (*) (a: Vector3i, c) = Vector3i(a.X * c, a.Y * c, a.Z * c) static member inline (/) (a: Vector3i, c) = Vector3i(a.X / c, a.Y / c, a.Z / c) static member inline (>>>) (a: Vector3i, c) = Vector3i(a.X >>> c, a.Y >>> c, a.Z >>> c) static member inline (<<<) (a: Vector3i, c) = Vector3i(a.X <<< c, a.Y <<< c, a.Z <<< c) static member inline (&&&) (a: Vector3i, c) = Vector3i(a.X &&& c, a.Y &&& c, a.Z &&& c) static member inline (+) (a: Vector3i, b: Vector3i) = Vector3i(a.X + b.X, a.Y + b.Y, a.Z + b.Z) static member inline (-) (a: Vector3i, b: Vector3i) = Vector3i(a.X - b.X, a.Y - b.Y, a.Z - b.Z) static member inline (*) (a: Vector3i, b: Vector3i) = Vector3i(a.X * b.X, a.Y * b.Y, a.Z * b.Z) static member inline (/) (a: Vector3i, b: Vector3i) = Vector3i(a.X / b.X, a.Y / b.Y, a.Z / b.Z) static member inline FromVector3(v : Vector3) = Vector3i(int v.X, int v.Y, int v.Z) // Float vector types [] module Vector2 = type Vector2 with static member FromRadians(a) = Vector2(cos a, sin a) static member FromDegrees(a) = Vector2.FromRadians(a * MathF.PI / 180.0f) static member inline Rotate(r : Vector2, a : Vector2) = Vector2(a.X * r.X - a.Y * r.Y, a.X * r.Y + a.Y * r.X) static member inline Perpendicular(v : Vector2) = Vector2(-v.Y, v.X) member v.GetRadians() = atan2 v.Y v.X member v.DivideOrZero(c) = if abs c > 1e-7f then v * (1.0f / c) else Vector2.Zero member v.NormalizeOrZero() = v.DivideOrZero(v.Length()) member v.TruncateOrZero(maxLength) = let lengthSqr = v.LengthSquared() if lengthSqr <= maxLength * maxLength then v else v.NormalizeOrZero() * maxLength member v.GetPerpendicular() = Vector2(-v.Y, v.X) member v.Rotate(r : Vector2) = Vector2(v.X * r.X - v.Y * r.Y, v.X * r.Y + v.Y * r.X) member v.InverseRotate(r : Vector2) = Vector2(v.X * r.X + v.Y * r.Y, v.Y * r.X - v.X * r.Y) /// Rotates towards a target vector /// maxRotation is a unit-length direction vector relative to X axis member v.RotateTowards(target : Vector2, maxRotation : Vector2) = let dot = Vector2.Dot(v, target) let rotDot = Vector2.Dot(maxRotation, Vector2.UnitX) if dot >= rotDot then target else let cross = Vector3.Cross(Vector3(v, 0.0f), Vector3(target, 0.0f)) if cross.Z > 0.0f then v.Rotate(maxRotation) else v.InverseRotate(maxRotation) member v.Round() = Vector2(floor (v.X + 0.5f), floor (v.Y + 0.5f)) member v.RoundToInt() = let v = v.Round() Vector2i(int v.X, int v.Y) member v.IsInTriangle(p0 : Vector2, p1 : Vector2, p2 : Vector2) = let a = 0.5f * (-p1.Y * p2.X + p0.Y * (-p1.X + p2.X) + p0.X * (p1.Y - p2.Y) + p1.X * p2.Y) let sign = if a < 0.0f then -1.0f else 1.0f; let s = (p0.Y * p2.X - p0.X * p2.Y + (p2.Y - p0.Y) * v.X + (p0.X - p2.X) * v.Y) * sign let t = (p0.X * p1.Y - p0.Y * p1.X + (p0.Y - p1.Y) * v.X + (p1.X - p0.X) * v.Y) * sign //s > 0.0f && t > 0.0f && (s + t) < 2.0f * A * sign s >= 0.0f && t >= 0.0f && (s + t) <= 2.0f * a * sign [] module Vector3 = type Vector3 with member v.ToVector2() = Vector2(v.X, v.Y) ================================================ FILE: samples/Garnet.Processor/Args.fs ================================================ namespace Garnet.Processor open Argu [] type PackArgs = | Input of string | Output of string | Compression of int | Ignore of string list | Recurse interface IArgParserTemplate with member this.Usage = match this with | Input _ -> "Input directory to pack" | Output _ -> "Output packed file" | Compression _ -> "Compression level, 0 for none" | Recurse -> "Include subdirectories recursively" | Ignore _ -> "Ignored file pattern, e.g. *.dat" and ProcessorArgs = | [] Pack of ParseResults interface IArgParserTemplate with member this.Usage = match this with | Pack _ -> "Pack files into a single archive file." ================================================ FILE: samples/Garnet.Processor/Garnet.Processor.fsproj ================================================  Exe net6.0 en true garnet Asset processor for games. asset game ================================================ FILE: samples/Garnet.Processor/PackUtility.fs ================================================ namespace Garnet.Processor open System.Diagnostics open System.IO open System.IO.Compression open System.Security.Cryptography open System.Text.RegularExpressions open Argu module PackUtility = let getHash file = if File.Exists(file) then use fs = File.OpenRead(file) use sha = SHA1.Create() sha.ComputeHash(fs) |> Array.map (fun b -> b.ToString("x2")) |> String.concat "" else "" let getGlobRegex (globs : string list) = if globs.Length = 0 then Regex("x^") else let pattern = globs |> List.map (fun str -> "^" + Regex.Escape(str).Replace(@"\*", ".*").Replace(@"\?", ".") + "$") |> String.concat "|" Regex(pattern, RegexOptions.IgnoreCase ||| RegexOptions.Singleline) let run (args : ParseResults) = let inputPath = Path.GetFullPath(args.GetResult <@ PackArgs.Input @>) let outputPath = Path.GetFullPath(args.GetResult <@ PackArgs.Output @>) let recurse = args.Contains <@ Recurse @> let ignoreRegex = getGlobRegex (args.GetResult(<@ Ignore @>, defaultValue = List.empty)) let level = let compression = args.GetResult (<@ Compression @>, defaultValue = 0) if compression = 0 then CompressionLevel.NoCompression else CompressionLevel.Optimal printfn $"Input path: {inputPath}" // Optionally insert version into output path let outputPath = let key = "{version}" if outputPath.Contains(key) then let exeFile = Directory.EnumerateFiles(inputPath, "*.exe") |> Seq.head let info = FileVersionInfo.GetVersionInfo(exeFile) outputPath.Replace(key, info.ProductVersion) else outputPath printfn $"Output path: {outputPath}" // Create folder let outputDir = Path.GetDirectoryName(outputPath) Directory.CreateDirectory(outputDir) |> ignore // Write to temp path let tempPath = outputPath + ".temp" let _ = use zip = ZipFile.Open(tempPath, ZipArchiveMode.Create) let options = EnumerationOptions() options.RecurseSubdirectories <- recurse for file in Directory.EnumerateFiles(inputPath, "*.*", options) do let fullPath = Path.GetFullPath(file) let name = Path.GetRelativePath(inputPath, fullPath) if ignoreRegex.IsMatch(name) then printfn $"Ignoring {name}" else printfn $"Adding {name}" zip.CreateEntryFromFile(fullPath, name, level) |> ignore // Calc hash of old and new files let oldHash = getHash outputPath let newHash = getHash tempPath printfn $"Old hash: {oldHash}" printfn $"New hash: {newHash}" // Overwrite only if hash differs if newHash = oldHash then printfn $"Hashes match, skipping write" File.Delete(tempPath) else File.Move(tempPath, outputPath, overwrite = true) let info = FileInfo(outputPath) printfn $"{info.Length} bytes written to {outputPath}" ================================================ FILE: samples/Garnet.Processor/Program.fs ================================================ open Argu open Garnet.Processor [] let main argv = let parser = ArgumentParser.Create() try let args = parser.ParseCommandLine(inputs = argv, raiseOnUsage = true) match args.GetSubCommand() with | Pack args -> PackUtility.run args with e -> printfn $"%s{e.Message}" 0 ================================================ FILE: samples/Garnet.Samples.Assorted/Extensions.fs ================================================ namespace Garnet.Samples.Assorted open System open System.Numerics open Veldrid open Garnet.Composition open Garnet.Graphics open Garnet.Input open Garnet.Numerics [] module Extensions = type Container with member c.AddPixelCoordinateCamera(cameraId) = c.On <| fun e -> // Set projection to use pixel coords let cameras = c.Get() cameras.[cameraId].ProjectionTransform <- Matrix4x4.CreateOrthographicOffCenter( 0.0f, float32 e.ViewSize.X, float32 e.ViewSize.Y, 0.0f, -1.0f, 1.0f) member c.AddEscapeToClose() = c.On <| fun e -> match e.KeyCode with | Key.Escape -> c.Get().Close() | _ -> () static member Run(register : Container -> IDisposable) = let c = Container() use sys = register c c.RunLoop() ================================================ FILE: samples/Garnet.Samples.Assorted/Garnet.Samples.Assorted.fsproj ================================================  WinExe net6.0 en true Link PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest ================================================ FILE: samples/Garnet.Samples.Assorted/OffscreenDrawing.fs ================================================ module Garnet.Samples.Assorted.OffscreenDrawing open System open System.Numerics open Garnet.Composition open Garnet.Graphics open Garnet.Numerics open Veldrid module Resources = let colorTextureShaderSet : ShaderSetDescriptor = { VertexShader = "shaders/texture-color.vert" FragmentShader = "shaders/texture-color.frag" } let spritePipeline = { Blend = Blend.Alpha Filtering = Filtering.Point ShaderSet = colorTextureShaderSet Texture = "textures/multicolor-square.png" } let spriteLayer = { LayerId = 0 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = spritePipeline } let lightPipeline = { Blend = Blend.Alpha Filtering = Filtering.Point ShaderSet = colorTextureShaderSet Texture = "textures/hex.png" } let lightLayer = { LayerId = 0 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = lightPipeline } type MainScene(ren : SpriteRenderer) = member c.Renderer = ren type LightScene(ren : SpriteRenderer) = member c.Renderer = ren type Container with member c.AddSpriteLightingDrawing() = let device = c.Get() let shaders = c.Get() let cache = c.Get() let lightTarget = let blend = BlendStateDescription(AttachmentStates = [| // Multiply destination (main scene) by source (light map) BlendAttachmentDescription( BlendEnabled = true, SourceColorFactor = BlendFactor.Zero, DestinationColorFactor = BlendFactor.SourceColor, ColorFunction = BlendFunction.Add, SourceAlphaFactor = BlendFactor.Zero, DestinationAlphaFactor = BlendFactor.SourceAlpha, AlphaFunction = BlendFunction.Add ) |]) let shaderSet = shaders.GetOrCreate(device, Resources.colorTextureShaderSet.Untyped, cache) let target = new RenderTarget(device, shaderSet, Filtering.Linear, blend) target.Background <- RgbaFloat.Clear target let mainSprites = new SpriteRenderer(device, shaders, cache) let lightSprites = new SpriteRenderer(device, shaders, cache) c.Set(MainScene(mainSprites)) c.Set(LightScene(lightSprites)) Disposable.Create [ mainSprites :> IDisposable lightSprites :> IDisposable lightTarget :> IDisposable c.On <| fun e -> lightTarget.Width <- e.ViewSize.X lightTarget.Height <- e.ViewSize.Y c.On <| fun _ -> let context = c.Get() let cameras = c.Get() // First draw scene normally mainSprites.Draw(context, cameras) // Next draw lights to offscreen buffer, then draw to main buffer // (with multiply blending) lightTarget.BeginDraw(context) lightSprites.Draw(context, cameras) lightTarget.EndDraw(context) ] let run() = Container.Run <| fun c -> c.Set { WindowSettings.Default with Background = RgbaFloat.Blue.MultiplyRgb(0.1f) } Disposable.Create [ c.AddDefaultSystems() c.AddPixelCoordinateCamera(0) c.AddEscapeToClose() c.AddSpriteLightingDrawing() c.On <| fun e -> let rect = Range2.Sized(Vector2.Zero, e.ViewSize.ToVector2()) // Draw sprites let sprites = c.Get().Renderer let verts = sprites.GetVertices(Resources.spriteLayer) verts.DrawQuad(rect, Range2.ZeroToOne, RgbaFloat.White) // Draw lights let lights = c.Get().Renderer let verts = lights.GetVertices(Resources.lightLayer) verts.DrawQuad(rect, Range2.ZeroToOne, RgbaFloat.White) ] ================================================ FILE: samples/Garnet.Samples.Assorted/Program.fs ================================================ open Garnet.Composition open Garnet.Samples.Assorted [] let main argv = //SpriteDrawing.run() //TextDrawing.run() OffscreenDrawing.run() 0 ================================================ FILE: samples/Garnet.Samples.Assorted/SpriteDrawing.fs ================================================ module Garnet.Samples.Assorted.SpriteDrawing open System open System.Numerics open Garnet.Composition open Garnet.Graphics open Garnet.Numerics open Veldrid module Resources = let colorTextureShaderSet : ShaderSetDescriptor = { VertexShader = "shaders/texture-color.vert" FragmentShader = "shaders/texture-color.frag" } let spritePipeline = { Blend = Blend.Alpha Filtering = Filtering.Point ShaderSet = colorTextureShaderSet Texture = "textures/multicolor-square.png" } let spriteLayer = { LayerId = 0 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = spritePipeline } let run() = Container.Run <| fun c -> c.Set { WindowSettings.Default with Background = RgbaFloat.Blue.MultiplyRgb(0.1f) } Disposable.Create [ c.AddDefaultSystems() c.AddPixelCoordinateCamera(0) c.AddEscapeToClose() c.On <| fun _ -> let sprites = c.Get() let verts = sprites.GetVertices(Resources.spriteLayer) let size = Vector2(80.0f, 40.0f) // Identical quads verts.DrawQuad( Range2.Centered(Vector2(50.0f, 50.0f), size), Range2.ZeroToOne, RgbaFloat.White) verts.DrawQuad { ColorTextureSprite.Default with Center = Vector2(150.0f, 50.0f) Size = size } // Rotated - Since we're using pixel coords, positive rotation is clockwise verts.DrawQuad { ColorTextureSprite.Default with Center = Vector2(250.0f, 50.0f) Size = size Rotation = Vector2.FromDegrees(90.0f) } ] ================================================ FILE: samples/Garnet.Samples.Assorted/TextDrawing.fs ================================================ module Garnet.Samples.Assorted.TextDrawing open Veldrid open Garnet.Composition open Garnet.Graphics open Garnet.Numerics module Resources = let font = "fonts/pixel-operator-regular-12.font.json" let fontTexture = "textures/pixel-operator-regular-12.png" let textureShaderSet : ShaderSetDescriptor = { VertexShader = "shaders/texture-color.vert" FragmentShader = "shaders/texture-color.frag" } let colorShaderSet : ShaderSetDescriptor = { VertexShader = "shaders/color.vert" FragmentShader = "shaders/color.frag" } let textPipeline = { Blend = Blend.Alpha // Use point filtering since we plan to scale the font and want a pixelated appearance Filtering = Filtering.Point ShaderSet = textureShaderSet Texture = "textures/pixel-operator-regular-12.png" } let panelPipeline = { Blend = Blend.Alpha Filtering = Filtering.Linear ShaderSet = colorShaderSet Texture = "" } let textLayer = { LayerId = 1 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = textPipeline } let panelLayer = { LayerId = 0 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = panelPipeline } let run() = Container.Run <| fun c -> c.Set { WindowSettings.Default with Width = 640; Height = 480 } Disposable.Create [ c.AddDefaultSystems() c.AddPixelCoordinateCamera(0) c.AddEscapeToClose() c.On <| fun e -> let font = c.LoadJsonFont(Resources.font, Resources.fontTexture) let sprites = c.Get() let textVerts = sprites.GetVertices(Resources.textLayer) let panelVerts = sprites.GetVertices(Resources.panelLayer) let baseBlock = { TextBlock.Default with Scale = 3 Bounds = Range2i.Sized(Vector2i.Zero, e.ViewSize) } // Draw text in the corners textVerts.DrawText(font, { baseBlock with Text = "Upper left" Align = Align.Left Valign = Valign.Top }) textVerts.DrawText(font, { baseBlock with Text = "Bottom right" Align = Align.Right Valign = Valign.Bottom }) // Draw text in the center within a panel let block = { baseBlock with Text = "Multiple Lines\nCenter" Align = Align.Center Valign = Valign.Center } let bounds = font.Measure(block).ToRange2() textVerts.DrawText(font, block) panelVerts.DrawQuad(bounds, RgbaFloat.Red.MultiplyAlpha(0.5f)) // Test wrapping let scale = 2 let text = "Title\n\nLine 1\nLine 2 should wrap to next line\nLine 3" let size = font.Measure(text) * scale let bounds = Range2i.Sized(Vector2i(0, e.ViewSize.Y - size.Y), Vector2i(size.X - 200, size.Y)) let block = { baseBlock with Scale = scale Bounds = bounds Text = text Align = Align.Left Valign = Valign.Center Wrapping = TextWrapping.WordWrap } textVerts.DrawText(font, block) panelVerts.DrawQuad(bounds.ToRange2(), RgbaFloat.Red.MultiplyAlpha(0.5f)) ] ================================================ FILE: samples/Garnet.Samples.Assorted/assets/fonts/pixel-operator-regular-12.font.json ================================================ { "family": "Pixel Operator", "style": "Regular", "size": 12, "height": 17, "chars": [ { "code": " ", "width": 4, "offsetX": 0, "offsetY": 13, "rectX": 1, "rectY": 12, "rectWidth": 0, "rectHeight": 0 }, { "code": "!", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 2, "rectY": 3, "rectWidth": 1, "rectHeight": 9 }, { "code": "\"", "width": 7, "offsetX": 2, "offsetY": 4, "rectX": 4, "rectY": 3, "rectWidth": 3, "rectHeight": 3 }, { "code": "#", "width": 8, "offsetX": 1, "offsetY": 4, "rectX": 8, "rectY": 3, "rectWidth": 6, "rectHeight": 9 }, { "code": "$", "width": 7, "offsetX": 1, "offsetY": 2, "rectX": 15, "rectY": 1, "rectWidth": 5, "rectHeight": 13 }, { "code": "%", "width": 9, "offsetX": 1, "offsetY": 4, "rectX": 21, "rectY": 3, "rectWidth": 7, "rectHeight": 9 }, { "code": "&", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 29, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "'", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 35, "rectY": 3, "rectWidth": 1, "rectHeight": 3 }, { "code": "(", "width": 7, "offsetX": 3, "offsetY": 4, "rectX": 37, "rectY": 3, "rectWidth": 3, "rectHeight": 9 }, { "code": ")", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 41, "rectY": 3, "rectWidth": 3, "rectHeight": 9 }, { "code": "*", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 45, "rectY": 3, "rectWidth": 5, "rectHeight": 5 }, { "code": "+", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 51, "rectY": 5, "rectWidth": 5, "rectHeight": 5 }, { "code": ",", "width": 5, "offsetX": 1, "offsetY": 12, "rectX": 57, "rectY": 11, "rectWidth": 2, "rectHeight": 3 }, { "code": "-", "width": 6, "offsetX": 1, "offsetY": 8, "rectX": 60, "rectY": 7, "rectWidth": 4, "rectHeight": 1 }, { "code": ".", "width": 5, "offsetX": 2, "offsetY": 12, "rectX": 65, "rectY": 11, "rectWidth": 1, "rectHeight": 1 }, { "code": "/", "width": 5, "offsetX": 1, "offsetY": 4, "rectX": 67, "rectY": 3, "rectWidth": 3, "rectHeight": 9 }, { "code": "0", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 71, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "1", "width": 7, "offsetX": 2, "offsetY": 4, "rectX": 77, "rectY": 3, "rectWidth": 3, "rectHeight": 9 }, { "code": "2", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 81, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "3", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 87, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "4", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 93, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "5", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 99, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "6", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 105, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "7", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 111, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "8", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 117, "rectY": 3, "rectWidth": 5, "rectHeight": 9 }, { "code": "9", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 1, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": ":", "width": 5, "offsetX": 2, "offsetY": 6, "rectX": 7, "rectY": 17, "rectWidth": 1, "rectHeight": 7 }, { "code": ";", "width": 5, "offsetX": 1, "offsetY": 6, "rectX": 9, "rectY": 17, "rectWidth": 2, "rectHeight": 9 }, { "code": "<", "width": 5, "offsetX": 1, "offsetY": 6, "rectX": 12, "rectY": 17, "rectWidth": 3, "rectHeight": 5 }, { "code": "=", "width": 6, "offsetX": 1, "offsetY": 7, "rectX": 16, "rectY": 18, "rectWidth": 4, "rectHeight": 3 }, { "code": ">", "width": 5, "offsetX": 1, "offsetY": 6, "rectX": 21, "rectY": 17, "rectWidth": 3, "rectHeight": 5 }, { "code": "?", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 25, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "@", "width": 9, "offsetX": 1, "offsetY": 4, "rectX": 31, "rectY": 15, "rectWidth": 7, "rectHeight": 9 }, { "code": "A", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 39, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "B", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 45, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "C", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 51, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "D", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 57, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "E", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 63, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "F", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 69, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "G", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 75, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "H", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 81, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "I", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 87, "rectY": 15, "rectWidth": 1, "rectHeight": 9 }, { "code": "J", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 89, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "K", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 95, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "L", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 101, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "M", "width": 9, "offsetX": 1, "offsetY": 4, "rectX": 107, "rectY": 15, "rectWidth": 7, "rectHeight": 9 }, { "code": "N", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 115, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "O", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 121, "rectY": 15, "rectWidth": 5, "rectHeight": 9 }, { "code": "P", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 1, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "Q", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 7, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "R", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 13, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "S", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 19, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "T", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 25, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "U", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 31, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "V", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 37, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "W", "width": 9, "offsetX": 1, "offsetY": 4, "rectX": 43, "rectY": 27, "rectWidth": 7, "rectHeight": 9 }, { "code": "X", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 51, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "Y", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 57, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "Z", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 63, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "[", "width": 7, "offsetX": 3, "offsetY": 4, "rectX": 69, "rectY": 27, "rectWidth": 3, "rectHeight": 9 }, { "code": "\\", "width": 5, "offsetX": 1, "offsetY": 4, "rectX": 73, "rectY": 27, "rectWidth": 3, "rectHeight": 9 }, { "code": "]", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 77, "rectY": 27, "rectWidth": 3, "rectHeight": 9 }, { "code": "^", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 81, "rectY": 27, "rectWidth": 5, "rectHeight": 3 }, { "code": "_", "width": 5, "offsetX": 0, "offsetY": 14, "rectX": 87, "rectY": 37, "rectWidth": 5, "rectHeight": 1 }, { "code": "`", "width": 5, "offsetX": 1, "offsetY": 4, "rectX": 93, "rectY": 27, "rectWidth": 2, "rectHeight": 2 }, { "code": "a", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 96, "rectY": 29, "rectWidth": 5, "rectHeight": 7 }, { "code": "b", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 102, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "c", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 108, "rectY": 29, "rectWidth": 5, "rectHeight": 7 }, { "code": "d", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 114, "rectY": 27, "rectWidth": 5, "rectHeight": 9 }, { "code": "e", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 120, "rectY": 29, "rectWidth": 5, "rectHeight": 7 }, { "code": "f", "width": 6, "offsetX": 1, "offsetY": 4, "rectX": 1, "rectY": 39, "rectWidth": 4, "rectHeight": 9 }, { "code": "g", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 6, "rectY": 41, "rectWidth": 5, "rectHeight": 9 }, { "code": "h", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 12, "rectY": 39, "rectWidth": 5, "rectHeight": 9 }, { "code": "i", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 18, "rectY": 39, "rectWidth": 1, "rectHeight": 9 }, { "code": "j", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 20, "rectY": 39, "rectWidth": 5, "rectHeight": 11 }, { "code": "k", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 26, "rectY": 39, "rectWidth": 5, "rectHeight": 9 }, { "code": "l", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 32, "rectY": 39, "rectWidth": 2, "rectHeight": 9 }, { "code": "m", "width": 9, "offsetX": 1, "offsetY": 6, "rectX": 35, "rectY": 41, "rectWidth": 7, "rectHeight": 7 }, { "code": "n", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 43, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "o", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 49, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "p", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 55, "rectY": 41, "rectWidth": 5, "rectHeight": 9 }, { "code": "q", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 61, "rectY": 41, "rectWidth": 5, "rectHeight": 9 }, { "code": "r", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 67, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "s", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 73, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "t", "width": 6, "offsetX": 1, "offsetY": 5, "rectX": 79, "rectY": 40, "rectWidth": 4, "rectHeight": 8 }, { "code": "u", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 84, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "v", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 90, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "w", "width": 9, "offsetX": 1, "offsetY": 6, "rectX": 96, "rectY": 41, "rectWidth": 7, "rectHeight": 7 }, { "code": "x", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 104, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "y", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 110, "rectY": 41, "rectWidth": 5, "rectHeight": 9 }, { "code": "z", "width": 7, "offsetX": 1, "offsetY": 6, "rectX": 116, "rectY": 41, "rectWidth": 5, "rectHeight": 7 }, { "code": "{", "width": 7, "offsetX": 2, "offsetY": 4, "rectX": 122, "rectY": 39, "rectWidth": 4, "rectHeight": 9 }, { "code": "|", "width": 5, "offsetX": 2, "offsetY": 4, "rectX": 1, "rectY": 51, "rectWidth": 1, "rectHeight": 9 }, { "code": "}", "width": 7, "offsetX": 1, "offsetY": 4, "rectX": 3, "rectY": 51, "rectWidth": 4, "rectHeight": 9 }, { "code": "~", "width": 8, "offsetX": 1, "offsetY": 4, "rectX": 8, "rectY": 51, "rectWidth": 6, "rectHeight": 2 } ] } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/color.frag ================================================ #version 450 layout(location = 0) in vec4 fsin_color; layout(location = 0) out vec4 fsout_color; void main() { fsout_color = fsin_color; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/color.frag.hlsl.bytes ================================================ static float4 _9; static float4 _11; struct SPIRV_Cross_Input { float4 _11 : TEXCOORD0; }; struct SPIRV_Cross_Output { float4 _9 : SV_Target0; }; void frag_main() { _9 = _11; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _11 = stage_input._11; frag_main(); SPIRV_Cross_Output stage_output; stage_output._9 = _9; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/color.vert ================================================ #version 450 layout(set = 0, binding = 0) uniform ProjectionBuffer { mat4 Projection; }; layout(set = 0, binding = 1) uniform ViewBuffer { mat4 View; }; layout(set = 1, binding = 0) uniform WorldBuffer { mat4 World; }; layout(location = 0) in vec3 Position; layout(location = 1) in vec4 Color; layout(location = 0) out vec4 fsin_Color; void main() { vec4 worldPosition = World * vec4(Position, 1); vec4 viewPosition = View * worldPosition; vec4 clipPosition = Projection * viewPosition; gl_Position = clipPosition; fsin_Color = Color; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/color.vert.hlsl.bytes ================================================ cbuffer _11_13 : register(b2) { row_major float4x4 _13_m0 : packoffset(c0); }; cbuffer _30_32 : register(b1) { row_major float4x4 _32_m0 : packoffset(c0); }; cbuffer _38_40 : register(b0) { row_major float4x4 _40_m0 : packoffset(c0); }; static float4 gl_Position; static float3 _21; static float4 _54; static float4 _56; struct SPIRV_Cross_Input { float3 _21 : TEXCOORD0; float4 _56 : TEXCOORD1; }; struct SPIRV_Cross_Output { float4 _54 : TEXCOORD0; float4 gl_Position : SV_Position; }; void vert_main() { gl_Position = mul(mul(mul(float4(_21, 1.0f), _13_m0), _32_m0), _40_m0); _54 = _56; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _21 = stage_input._21; _56 = stage_input._56; vert_main(); SPIRV_Cross_Output stage_output; stage_output.gl_Position = gl_Position; stage_output._54 = _54; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/texture-color.frag ================================================ #version 450 layout(location = 0) in vec2 fsin_texCoords; layout(location = 1) in vec4 fsin_color; layout(location = 0) out vec4 fsout_color; layout(set = 1, binding = 1) uniform texture2D SurfaceTexture; layout(set = 1, binding = 2) uniform sampler SurfaceSampler; void main() { vec4 texColor = texture(sampler2D(SurfaceTexture, SurfaceSampler), fsin_texCoords); fsout_color = texColor * fsin_color; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/texture-color.frag.hlsl.bytes ================================================ Texture2D _12 : register(t0); SamplerState _16 : register(s0); static float2 _22; static float4 _26; static float4 _29; struct SPIRV_Cross_Input { float2 _22 : TEXCOORD0; float4 _29 : TEXCOORD1; }; struct SPIRV_Cross_Output { float4 _26 : SV_Target0; }; void frag_main() { _26 = _12.Sample(_16, _22) * _29; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _22 = stage_input._22; _29 = stage_input._29; frag_main(); SPIRV_Cross_Output stage_output; stage_output._26 = _26; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/texture-color.vert ================================================ #version 450 layout(set = 0, binding = 0) uniform ProjectionBuffer { mat4 Projection; }; layout(set = 0, binding = 1) uniform ViewBuffer { mat4 View; }; layout(set = 1, binding = 0) uniform WorldBuffer { mat4 World; }; layout(location = 0) in vec3 Position; layout(location = 1) in vec2 TexCoords; layout(location = 2) in vec4 Color; layout(location = 0) out vec2 fsin_texCoords; layout(location = 1) out vec4 fsin_Color; void main() { vec4 worldPosition = World * vec4(Position, 1); vec4 viewPosition = View * worldPosition; vec4 clipPosition = Projection * viewPosition; gl_Position = clipPosition; fsin_texCoords = TexCoords; fsin_Color = Color; } ================================================ FILE: samples/Garnet.Samples.Assorted/assets/shaders/texture-color.vert.hlsl.bytes ================================================ cbuffer _11_13 : register(b2) { row_major float4x4 _13_m0 : packoffset(c0); }; cbuffer _30_32 : register(b1) { row_major float4x4 _32_m0 : packoffset(c0); }; cbuffer _38_40 : register(b0) { row_major float4x4 _40_m0 : packoffset(c0); }; static float4 gl_Position; static float3 _21; static float2 _56; static float2 _58; static float4 _60; static float4 _62; struct SPIRV_Cross_Input { float3 _21 : TEXCOORD0; float2 _58 : TEXCOORD1; float4 _62 : TEXCOORD2; }; struct SPIRV_Cross_Output { float2 _56 : TEXCOORD0; float4 _60 : TEXCOORD1; float4 gl_Position : SV_Position; }; void vert_main() { gl_Position = mul(mul(mul(float4(_21, 1.0f), _13_m0), _32_m0), _40_m0); _56 = _58; _60 = _62; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _21 = stage_input._21; _58 = stage_input._58; _62 = stage_input._62; vert_main(); SPIRV_Cross_Output stage_output; stage_output.gl_Position = gl_Position; stage_output._56 = _56; stage_output._60 = _60; return stage_output; } ================================================ FILE: samples/Garnet.Samples.CSharp/Garnet.Samples.CSharp.csproj ================================================  WinExe net6.0 en true Link ================================================ FILE: samples/Garnet.Samples.CSharp/Program.cs ================================================ using Garnet.Composition; var c = new Container(); using (c.AddDefaultSystems()) { c.RunLoop(); } ================================================ FILE: samples/Garnet.Samples.Flocking/Debug.fs ================================================ namespace Garnet.Samples.Flocking open System open System.Numerics open System.Diagnostics open ImGuiNET open Garnet.Composition type FpsHud() = let fps = FpsGauge(1.0f) let fixedFps = FpsGauge(1.0f) member _.OnFixedUpdate() = let timestamp = Stopwatch.GetTimestamp() fixedFps.Update(timestamp) member _.OnUpdate() = let timestamp = Stopwatch.GetTimestamp() fps.Update(timestamp) member _.Draw() = let flags = ImGuiWindowFlags.NoBackground ||| ImGuiWindowFlags.NoTitleBar ||| ImGuiWindowFlags.NoResize ||| ImGuiWindowFlags.NoMove ||| ImGuiWindowFlags.NoFocusOnAppearing ||| ImGuiWindowFlags.NoInputs ||| ImGuiWindowFlags.NoNavFocus ImGui.SetNextWindowSize(Vector2(500.0f, 500.0f)) ImGui.SetNextWindowPos(Vector2(0.0f, 0.0f)) if ImGui.Begin("Hud", flags) then let info = GC.GetGCMemoryInfo() ImGui.SetWindowFontScale(1.0f) ImGui.Text $"FPS: %d{int fps.FramesPerSec}, mean: %d{int fps.MeanFrameMs} ms, max: %d{int fps.MaxFrameMs} ms, fixed FPS: %d{int fixedFps.FramesPerSec}" ImGui.Text $"GC pause: {info.PauseTimePercentage}%%%%, heap size: {info.HeapSizeBytes / 1024L} Kb" ImGui.End() module DebugSystem = let add (c : Container) = let hud = c.Get() Disposable.Create [ c.On <| fun _ -> hud.OnFixedUpdate() c.On <| fun _ -> hud.OnUpdate() c.On <| fun _ -> hud.Draw() ] ================================================ FILE: samples/Garnet.Samples.Flocking/Drawing.fs ================================================ namespace Garnet.Samples.Flocking open System open System.Numerics open Garnet.Composition open Garnet.Numerics open Garnet.Graphics module DrawingSystems = type Container with member c.AddCameraUpdates() = c.On <| fun e -> // Update transforms so origin is in the center of the screen and we use pixel coords // with +Y as up. let displayScale = 1.0f let size = e.ViewSize.ToVector2() / displayScale let camera = c.Get().[0] camera.ProjectionTransform <- Matrix4x4.CreateOrthographic(size.X, size.Y, -100.0f, 100.0f) member c.AddVehicleSprites() = c.On <| fun _ -> let atlas = c.LoadResource(Resources.atlas) let layers = c.Get() let texBounds = atlas.[Resources.triangleTexture].NormalizedBounds let mesh = layers.GetVertices(Resources.vehicleLayer) for r in c.Query() do mesh.DrawQuad { Center = r.Value2.Pos Size = 0.1f * Vector2(1.0f, 1.0f) * 140.0f Rotation = r.Value4.Direction TexBounds = texBounds Color = Faction.toColor r.Value3 } member c.AddTrailSprites() = c.On <| fun _ -> let atlas = c.LoadResource(Resources.atlas) let layers = c.Get() let texBounds = atlas.[Resources.hexTexture].NormalizedBounds let mesh = layers.GetVertices(Resources.trailLayer) for r in c.Query() do mesh.DrawQuad { Center = r.Value2.Pos Size = r.Value4.Lifespan * 0.3f * Vector2.One * 60.0f Rotation = Vector2.FromRadians(r.Value5.Radians) TexBounds = texBounds Color = (Faction.toColor r.Value3).MultiplyAlpha(r.Value4.Lifespan * 0.3f) } let add (c : Container) = Disposable.Create [ c.AddCameraUpdates() c.AddVehicleSprites() c.AddTrailSprites() ] ================================================ FILE: samples/Garnet.Samples.Flocking/Functions.fs ================================================ namespace Garnet.Samples.Flocking open System.Collections.Generic open System.Numerics open Veldrid open Garnet.Numerics module WorldSettings = let defaults = { Seed = 1 VehicleCount = 100 SpawnRange = 300.0f MaxVehicleSpeed = 50.0f TrailLifespan = 0.6f Steering = { ForwardWeight = 20.0f CohesionWeight = 3.0f TetherWeight = 1.0f SeparationWeight = 3.0f AlignmentWeight = 1.0f MaxAlignmentDistance = 100.0f MaxSeparationDistance = 70.0f MaxCohesionDistance = 400.0f MaxTetherDistance = 300.0f } } module Scalar = let tolerance = 1e-9f let clamp (s0 : float32) (s1 : float32) (s : float32) = s |> max s0 |> min s1 let linearStep s0 s1 s = let length = s1 - s0 if abs length < tolerance then 0.0f else clamp 0.0f 1.0f ((s - s0) / length) let smoothStep s0 s1 s = let x = linearStep s0 s1 s x * x * (3.0f - 2.0f * x) module Heading = let getVelocity vehicle = vehicle.Speed * vehicle.Direction let fromVelocity (newVelocity : Vector2) = let newSpeed = newVelocity.Length() { Speed = newSpeed Direction = newVelocity.DivideOrZero(newSpeed) } let getNextPosition (deltaTime : float32) vehicle pos = let velocity = getVelocity vehicle let delta = deltaTime * velocity pos + delta module Steering = let getForward current = current.SteerDir let getTether maxDistance current = let tetherPoint = Vector2.Zero let toTether = tetherPoint - current.SteerPos let distance = toTether.Length() let scale = Scalar.smoothStep 0.0f maxDistance distance toTether.DivideOrZero(distance) * scale let getCohesion minDistance maxDistance (neighbors : List) = let mutable sum = Vector2.Zero for neighbor in neighbors do let weight = Scalar.smoothStep minDistance maxDistance neighbor.Distance sum <- sum + (neighbor.TeamWeight * weight) * neighbor.DirectionToNeighbor sum.NormalizeOrZero() let getSeparation maxDistance (neighbors : List<_>) = let mutable sum = Vector2.Zero for neighbor in neighbors do let weight = Scalar.smoothStep maxDistance 0.0f neighbor.Distance sum <- sum + -weight * neighbor.DirectionToNeighbor sum let getAlignment maxDistance (neighbors : List<_>) current = let mutable sum = Vector2.Zero for neighbor in neighbors do let weight = Scalar.smoothStep maxDistance 0.0f neighbor.Distance sum <- sum + -(neighbor.TeamWeight * weight) * current.SteerDir sum.NormalizeOrZero() let getSteeringDirection s neighbors current = let sum = getForward current * s.ForwardWeight + getTether s.MaxTetherDistance current * s.TetherWeight + getCohesion s.MaxSeparationDistance s.MaxCohesionDistance neighbors * s.CohesionWeight + getSeparation s.MaxSeparationDistance neighbors * s.SeparationWeight + getAlignment s.MaxAlignmentDistance neighbors current * s.AlignmentWeight sum.NormalizeOrZero() module Faction = let all = [| Red Orange Yellow Green Cyan Blue Purple |] let toColor = function | Red -> RgbaFloat(1.0f, 0.0f, 0.2f, 1.0f) | Orange -> RgbaFloat(1.0f, 0.4f, 0.0f, 1.0f) | Yellow -> RgbaFloat(0.6f, 1.0f, 0.0f, 1.0f) | Green -> RgbaFloat(0.0f, 1.0f, 0.1f, 1.0f) | Cyan -> RgbaFloat(0.0f, 0.8f, 0.6f, 1.0f) | Blue -> RgbaFloat(0.0f, 0.4f, 1.0f, 1.0f) | Purple -> RgbaFloat(0.6f, 0.0f, 1.0f, 1.0f) ================================================ FILE: samples/Garnet.Samples.Flocking/Garnet.Samples.Flocking.fsproj ================================================  WinExe net6.0 en true Link PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest ================================================ FILE: samples/Garnet.Samples.Flocking/Program.fs ================================================ open Garnet.Composition open Garnet.Samples.Flocking [] let main _ = let c = Container() use s = c.AddSystems [ StartupSystem.add SimulationSystems.add DrawingSystems.add DebugSystem.add ] c.RunLoop() 0 ================================================ FILE: samples/Garnet.Samples.Flocking/Resources.fs ================================================ namespace Garnet.Samples.Flocking open Garnet.Graphics module Resources = let shaderSet : ShaderSetDescriptor = { VertexShader = "texture-color.vert" FragmentShader = "texture-color.frag" } let atlas = "textures" let hexTexture = "hex.png" let triangleTexture = "triangle.png" let pipeline = { Blend = Blend.Alpha Filtering = Filtering.Linear ShaderSet = shaderSet Texture = atlas } let vehicleLayer = { LayerId = 2 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = pipeline } let trailLayer = { LayerId = 1 CameraId = 0 Primitive = Quad FlushMode = FlushOnDraw Pipeline = pipeline } ================================================ FILE: samples/Garnet.Samples.Flocking/Simulation.fs ================================================ namespace Garnet.Samples.Flocking open System open System.Collections.Generic open System.Numerics open Garnet.Numerics open Garnet.Composition // Not we're using Update instead of FixedUpdate here, mainly because this demo // is intended to measure performance. Normally it would be preferable to use // FixedUpdate for simulation logic. module SimulationSystems = type Container with member c.AddSpawning() = c.On <| fun _ -> let settings = c.Get() let rand = Random(settings.Seed) let nextCoord() = float32 (rand.NextDouble() - 0.5) * settings.SpawnRange for i = 1 to settings.VehicleCount do c.Create() .With(Faction.all.[rand.Next Faction.all.Length]) .With({ MaxSpeed = settings.MaxVehicleSpeed; Radius = 1.0f }) .With({ Pos = Vector2(nextCoord(), nextCoord()) }) .With({ Direction = Vector2(0.0f, 1.0f); Speed = 0.0f }) .Add(TrailEmitter()) member c.AddSteering() = let neighbors = List() c.On <| fun _ -> let settings = c.Get().Steering for r in c.Query() do let h = &r.Value3 let current = { Eid = r.Value1 Pos = r.Value2.Pos Dir = h.Direction Faction = r.Value4 } // For simplicity and testing performance, we're iterating over all vehicles // rather than using any spatial partitioning. for r in c.Query() do if r.Value1 <> current.Eid then let offset = r.Value4.Pos - current.Pos let distance = offset.Length() neighbors.Add { Direction = r.Value2.Direction TeamWeight = if current.Faction = r.Value3 then 1.0f else 0.0f DirectionToNeighbor = offset.DivideOrZero(distance) Distance = distance } let current = { SteerPos = current.Pos SteerDir = current.Dir } let dir = Steering.getSteeringDirection settings neighbors current let velocity = dir * r.Value5.MaxSpeed neighbors.Clear() h <- Heading.fromVelocity velocity member c.AddLifespan() = c.On <| fun e -> let dt = float32 e.DeltaTime / 1000.0f for r in c.Query() do let ls = r.Value1 let newLifespan = { Lifespan = ls.Lifespan - dt } if ls.Lifespan <= 0.0f then let eid = r.Value2 c.Destroy(eid) r.Value1 <- newLifespan member c.AddUpdatePosition() = c.On <| fun e -> let dt = float32 e.DeltaTime / 1000.0f for r in c.Query() do r.Value1 <- { Pos = Heading.getNextPosition dt r.Value2 r.Value1.Pos } member c.AddUpdateRotation() = c.On <| fun e -> let dt = float32 e.DeltaTime / 1000.0f for r in c.Query() do r.Value1 <- { Radians = r.Value1.Radians + dt * r.Value2.RotationSpeed } member c.AddTrailEmission() = c.On <| fun _ -> for r in c.Query() do c.Create() .With(r.Value3) .With(r.Value2) .With({ Radians = r.Value4.Direction.GetRadians() }) .With({ Lifespan = 0.6f }) .Add(Trail()) let add (c : Container) = Disposable.Create [ c.AddSpawning() c.AddLifespan() c.AddUpdatePosition() c.AddUpdateRotation() c.AddTrailEmission() c.AddSteering() ] ================================================ FILE: samples/Garnet.Samples.Flocking/Startup.fs ================================================ namespace Garnet.Samples.Flocking open System open Veldrid open Garnet.Composition open Garnet.Graphics module StartupSystem = type Container with member c.LoadResources() = // Manually load textures into atlas. Note other resources like // shaders can be loaded on demand and don't need to be explicitly // loaded here. let device = c.Get() let cache = c.Get() use fs = new FileFolder("assets") fs.LoadTextureAtlasFromFolder(device, Resources.atlas, 512, 512, cache) Disposable.Null let add (c : Container) = // Set global window settings, which will be used by default systems c.Set { WindowSettings.Default with Title = "Flocking" Width = 800 Height = 600 Background = RgbaFloat(0.0f, 0.1f, 0.2f, 1.0f) } // Set global settings used by simulation c.Set(WorldSettings.defaults) Disposable.Create [ // Default systems for window, sprite drawing, updates, etc c.AddDefaultSystems() c.LoadResources() ] ================================================ FILE: samples/Garnet.Samples.Flocking/Types.fs ================================================ namespace Garnet.Samples.Flocking open System.Numerics open Garnet.Composition [] module Components = [] type Faction = | Red | Orange | Yellow | Green | Cyan | Blue | Purple [] type Position = { Pos : Vector2 } [] type Heading = { Direction : Vector2 Speed : float32 } [] type Vehicle = { Radius : float32 MaxSpeed : float32 } [] type TrailLifespan = { TrailLifespan : float32 } [] type Lifespan = { Lifespan : float32 } [] type AngularVelocity = { RotationSpeed : float32 } [] type Rotation = { Radians : float32 } type TrailEmitter = struct end type Trail = struct end [] module Settings = type SteeringSettings = { ForwardWeight : float32 CohesionWeight : float32 TetherWeight : float32 SeparationWeight : float32 AlignmentWeight : float32 MaxAlignmentDistance : float32 MaxSeparationDistance : float32 MaxCohesionDistance : float32 MaxTetherDistance : float32 } type WorldSettings = { Seed : int SpawnRange : float32 VehicleCount : int MaxVehicleSpeed : float32 TrailLifespan : float32 Steering : SteeringSettings } [] module SteeringTypes = [] type Steerer = { SteerPos : Vector2 SteerDir : Vector2 } [] type Neighbor = { Direction : Vector2 DirectionToNeighbor : Vector2 Distance : float32 TeamWeight : float32 } [] type CurrentVehicle = { Eid : Eid Pos : Vector2 Dir : Vector2 Faction : Faction } [] module Events = type Reset = struct end ================================================ FILE: samples/Garnet.Samples.Flocking/assets/texture-color.frag ================================================ #version 450 layout(location = 0) in vec2 fsin_texCoords; layout(location = 1) in vec4 fsin_color; layout(location = 0) out vec4 fsout_color; layout(set = 1, binding = 1) uniform texture2D SurfaceTexture; layout(set = 1, binding = 2) uniform sampler SurfaceSampler; void main() { vec4 texColor = texture(sampler2D(SurfaceTexture, SurfaceSampler), fsin_texCoords); fsout_color = texColor * fsin_color; } ================================================ FILE: samples/Garnet.Samples.Flocking/assets/texture-color.frag.hlsl.bytes ================================================ Texture2D _12 : register(t0); SamplerState _16 : register(s0); static float2 _22; static float4 _26; static float4 _29; struct SPIRV_Cross_Input { float2 _22 : TEXCOORD0; float4 _29 : TEXCOORD1; }; struct SPIRV_Cross_Output { float4 _26 : SV_Target0; }; void frag_main() { _26 = _12.Sample(_16, _22) * _29; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _22 = stage_input._22; _29 = stage_input._29; frag_main(); SPIRV_Cross_Output stage_output; stage_output._26 = _26; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Flocking/assets/texture-color.vert ================================================ #version 450 layout(set = 0, binding = 0) uniform ProjectionBuffer { mat4 Projection; }; layout(set = 0, binding = 1) uniform ViewBuffer { mat4 View; }; layout(set = 1, binding = 0) uniform WorldBuffer { mat4 World; }; layout(location = 0) in vec3 Position; layout(location = 1) in vec2 TexCoords; layout(location = 2) in vec4 Color; layout(location = 0) out vec2 fsin_texCoords; layout(location = 1) out vec4 fsin_Color; void main() { vec4 worldPosition = World * vec4(Position, 1); vec4 viewPosition = View * worldPosition; vec4 clipPosition = Projection * viewPosition; gl_Position = clipPosition; fsin_texCoords = TexCoords; fsin_Color = Color; } ================================================ FILE: samples/Garnet.Samples.Flocking/assets/texture-color.vert.hlsl.bytes ================================================ cbuffer _11_13 : register(b2) { row_major float4x4 _13_m0 : packoffset(c0); }; cbuffer _30_32 : register(b1) { row_major float4x4 _32_m0 : packoffset(c0); }; cbuffer _38_40 : register(b0) { row_major float4x4 _40_m0 : packoffset(c0); }; static float4 gl_Position; static float3 _21; static float2 _56; static float2 _58; static float4 _60; static float4 _62; struct SPIRV_Cross_Input { float3 _21 : TEXCOORD0; float2 _58 : TEXCOORD1; float4 _62 : TEXCOORD2; }; struct SPIRV_Cross_Output { float2 _56 : TEXCOORD0; float4 _60 : TEXCOORD1; float4 gl_Position : SV_Position; }; void vert_main() { gl_Position = mul(mul(mul(float4(_21, 1.0f), _13_m0), _32_m0), _40_m0); _56 = _58; _60 = _62; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _21 = stage_input._21; _58 = stage_input._58; _62 = stage_input._62; vert_main(); SPIRV_Cross_Output stage_output; stage_output.gl_Position = gl_Position; stage_output._56 = _56; stage_output._60 = _60; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Roguelike/ConsoleTest.fsx ================================================ #load "Types.fs" #load "Functions.fs" open Garnet.Samples.Roguelike.Types open Garnet.Samples.Roguelike let test() = let world = World.generate 10 1 World.format world |> printfn "%s" World.getDistanceMap world [ Vector.zero ] |> DistanceMap.format |> printfn "%s" [ Move West; Move West ] |> Seq.fold Loop.stepWorld world |> World.format |> printfn "%s" let testInteractive() = World.generate 10 1 |> Loop.run ================================================ FILE: samples/Garnet.Samples.Roguelike/Drawing.fs ================================================ namespace Garnet.Samples.Roguelike open System.Buffers open System.Runtime.CompilerServices open Veldrid open Garnet.Graphics [] type DisplayTile = { ch : char fg : RgbaFloat bg : RgbaFloat } module DisplayTile = let fromTile tile = match tile.Entity with | Some entity -> match entity.EntityType with | Rogue -> { ch = '@' fg = RgbaFloat(0.3f, 1.0f, 1.0f, 1.0f) bg = RgbaFloat(0.3f, 1.0f, 1.0f, 0.3f) } | Minion -> { ch = 'm' fg = RgbaFloat(1.0f, 0.3f, 0.3f, 1.0f) bg = RgbaFloat(1.0f, 0.3f, 0.3f, 0.3f) } | None -> match tile.Terrain with | Floor -> { ch = '.' fg = RgbaFloat(0.3f, 0.4f, 0.5f, 0.5f) bg = RgbaFloat(0.3f, 0.4f, 0.5f, 0.1f) } | Wall -> { ch = '#' fg = RgbaFloat(0.3f, 0.4f, 0.5f, 1.0f) bg = RgbaFloat(0.3f, 0.4f, 0.5f, 0.3f) } [] type ViewExtensions = [] static member DrawWorld(w : IBufferWriter, world : World) = let span = w.GetTileSpan(world.Tiles.Count) let min = World.getMinLocation world let mutable i = 0 for kvp in world.Tiles do let p = Vector.subtract kvp.Key min let tile = DisplayTile.fromTile kvp.Value span.Slice(i * 4).DrawTile(p.X, p.Y, tile.ch, tile.fg, tile.bg) i <- i + 1 w.Advance(span.Length) ================================================ FILE: samples/Garnet.Samples.Roguelike/Functions.fs ================================================ namespace Garnet.Samples.Roguelike open System open System.Collections.Generic module Vector = let init x y = { X = x; Y = y } let zero = init 0 0 let one = init 1 1 let min a b = { X = min a.X b.X; Y = min a.Y b.Y } let max a b = { X = max a.X b.X; Y = max a.Y b.Y } let add a b = { X = a.X + b.X Y = a.Y + b.Y } let subtract a b = { X = a.X - b.X Y = a.Y - b.Y } module Bounds = let init min max = { Min = min; Max = max } let sized min size = init min (Vector.add min size) let zero = init Vector.zero Vector.zero let zeroToOne = init Vector.zero Vector.one let maxToMin = { Min = { X = Int32.MaxValue; Y = Int32.MaxValue } Max = { X = Int32.MinValue; Y = Int32.MinValue } } let including bounds p = { Min = Vector.min bounds.Min p Max = Vector.max bounds.Max p } let union a b = { Min = Vector.min a.Min b.Min Max = Vector.max a.Max b.Max } let getSize b = Vector.subtract b.Max b.Min let getCenter b = let v = Vector.add b.Max b.Min { X = v.X / 2; Y = v.Y / 2 } let getCentered contentSize b = let size = getSize b { X = b.Min.X + (size.X - contentSize.X) / 2 Y = b.Min.Y + (size.Y - contentSize.Y) / 2 } let expand margin b = { Min = Vector.subtract b.Min margin.Min Max = Vector.add b.Max margin.Max } let includingAll locs = locs |> Seq.fold including maxToMin |> expand zeroToOne module Direction = let all = [| East North West South |] let getNext loc dir = match dir with | East -> { loc with X = loc.X + 1 } | West -> { loc with X = loc.X - 1 } | North -> { loc with Y = loc.Y - 1 } | South -> { loc with Y = loc.Y + 1 } module DistanceMap = let empty = { Distances = Map.empty } let create isPassable (tiles : Map) seeds = let result = Dictionary() let queue = Queue() let enqueue p dist = if not (result.ContainsKey(p)) then let canVisit = match tiles.TryGetValue(p) with | false, _ -> false | true, tile -> isPassable tile result.Add(p, if canVisit then dist else Int32.MaxValue) if canVisit then queue.Enqueue(struct(p, dist)) for seed in seeds do enqueue seed 0 while queue.Count > 0 do let struct(p, dist) = queue.Dequeue() let nextDist = dist + 1 for dir in Direction.all do let next = Direction.getNext p dir enqueue next nextDist { Distances = result |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq } let getDistance p map = match map.Distances.TryGetValue(p) with | true, dist -> dist | false, _ -> Int32.MaxValue let distanceToChar x = if x = 0 then '.' elif x < 10 then '0' + char x elif x < 36 then 'a' + char (x - 10) elif x < 62 then 'A' + char (x - 36) elif x = Int32.MaxValue then '#' else '+' let format map = let b = map.Distances |> Seq.map (fun kvp -> kvp.Key) |> Bounds.includingAll let size = Bounds.getSize b let dw = size.X + 1 let data = Array.create (dw * size.Y) ' ' for y = 0 to size.Y - 1 do data.[y * dw + dw - 1] <- '\n' for kvp in map.Distances do let p = Vector.subtract kvp.Key b.Min data.[p.Y * dw + p.X] <- distanceToChar kvp.Value String(data) module Tile = let getChar tile = match tile.Entity with | Some e -> match e.EntityType with | Rogue -> '@' | Minion -> 'm' | None -> match tile.Terrain with | Floor -> '.' | Wall -> '#' let getMoveEvents loc nextLoc dir tile = seq { match tile.Entity with | Some entity -> if entity.Hits = 1 then yield Destroyed nextLoc else yield Attacked { AttackerLoc = loc AttackDir = dir Damage = 1 } | None -> yield Moved { SourceLoc = loc MoveDir = dir } } let addEntity entity tile = { tile with Entity = Some entity } let removeEntity tile = { tile with Entity = None } let isPassable tile = match tile.Terrain with | Wall -> false | Floor -> true module Entity = let rogue = { EntityType = Rogue Hits = 3 } let minion = { EntityType = Minion Hits = 1 } let applyDamage damage entity = { entity with Hits = entity.Hits - damage } module Animation = let format = function | Moving e -> $"Moved {e.MoveDir}" | Attacking e -> $"{e.AttackerEntityType} attacked {e.TargetEntityType}" | Destroying e -> $"{e.DestroyedEntityType} destroyed" module World = let empty = { Turn = 0 RandomSeed = 0UL Tiles = Map.empty Animations = List.empty } let generate mapRadius seed = let r = mapRadius + 1 let extent = r * 2 + 1 let count = extent * extent let rand = Random(seed) // draw random walls with border let cells1 = Array.zeroCreate count for y = -r to r do for x = -r to r do let i = (y + r) * extent + (x + r) let dist = max (abs x) (abs y) let cell = dist = r || (dist > 2 && rand.Next(10) = 0) cells1.[i] <- cell // apply morphological dilate let cells2 = Array.zeroCreate count let rm = r - 1 for y = -rm to rm do for x = -rm to rm do let i = (y + r) * extent + (x + r) let cell = if cells1.[i] then true else let ix0 = i - 1 let ix1 = i + 1 let iy0 = i - extent let iy1 = i + extent cells1.[ix0] || cells1.[ix1] || cells1.[iy0] || cells1.[iy1] cells2.[i] <- cell // populate tiles let tiles = seq { for y = -rm to rm do for x = -rm to rm do let i = (y + r) * extent + (x + r) let terrain = if cells2.[i] then Wall else Floor let p = Vector.init x y yield p, { Terrain = terrain Entity = match terrain with | Wall -> None | Floor -> if p = Vector.zero then Some Entity.rogue elif rand.Next(8) = 0 then Some Entity.minion else None } } { empty with RandomSeed = uint64 seed Tiles = Map.ofSeq tiles } let getMinLocation world = world.Tiles |> Seq.map (fun kvp -> kvp.Key) |> Seq.reduce Vector.min let formatTiles world = let b = world.Tiles |> Seq.map (fun kvp -> kvp.Key) |> Bounds.includingAll let size = Bounds.getSize b let dw = size.X + 1 let data = Array.create (dw * size.Y) ' ' for y = 0 to size.Y - 1 do data.[y * dw + dw - 1] <- '\n' for kvp in world.Tiles do let p = Vector.subtract kvp.Key b.Min data.[p.Y * dw + p.X] <- Tile.getChar kvp.Value String(data) let formatAnimations world = world.Animations |> List.rev |> Seq.map Animation.format |> String.concat "\n" let format world = $"Turn {world.Turn}:\n{formatAnimations world}\n{formatTiles world}" let getEntityLocations entityType world = seq { for kvp in world.Tiles do match kvp.Value.Entity with | Some entity -> if entity.EntityType = entityType then yield kvp.Key | None -> () } let isOccupied loc world = match Map.tryFind loc world.Tiles with | Some tile -> tile.Terrain = Wall || tile.Entity.IsSome | None -> true let tryGetEntity loc world = Map.tryFind loc world.Tiles |> Option.bind (fun tile -> tile.Entity) let mapTile map loc world = match Map.tryFind loc world.Tiles with | Some tile -> { world with Tiles = Map.add loc (map tile) world.Tiles } | None -> world let mapEntity map loc world = mapTile (fun tile -> { tile with Entity = Option.map map tile.Entity }) loc world let addEntity loc entity world = mapTile (Tile.addEntity entity) loc world let removeEntity loc world = mapTile Tile.removeEntity loc world let moveEntity loc newLoc world = match tryGetEntity loc world with | Some entity -> world |> removeEntity loc |> addEntity newLoc entity | None -> world let appendAnimation anim world = { world with Animations = anim :: world.Animations } let find entityType world = world.Tiles |> Map.tryPick (fun loc tile -> tile.Entity |> Option.bind (fun e -> if e.EntityType = entityType then Some (loc, e) else None)) let getDistanceMap map targets = DistanceMap.create Tile.isPassable map.Tiles targets let stepTurn world = { world with Turn = world.Turn + 1 } module Action = let getEvents action loc world = match action with | Move dir -> let nextLoc = Direction.getNext loc dir match Map.tryFind nextLoc world.Tiles with | Some tile -> Tile.getMoveEvents loc nextLoc dir tile | None -> Seq.empty let getPlayerEvents action world = match World.find Rogue world with | Some (loc, _) -> getEvents action loc world | None -> Seq.empty module Event = let applyEvent world event = match event with | Attacked e -> match World.tryGetEntity e.AttackerLoc world with | None -> world | Some attacker -> let targetLoc = Direction.getNext e.AttackerLoc e.AttackDir match World.tryGetEntity targetLoc world with | None -> world | Some target -> world |> World.mapEntity (Entity.applyDamage e.Damage) targetLoc |> World.appendAnimation (Attacking { AttackerLoc = e.AttackerLoc AttackerEntityType = attacker.EntityType AttackDir = e.AttackDir Damage = e.Damage TargetEntityType = target.EntityType }) | Moved e -> let targetLoc = Direction.getNext e.SourceLoc e.MoveDir world |> World.moveEntity e.SourceLoc targetLoc |> World.appendAnimation (Moving { SourceLoc = e.SourceLoc MoveDir = e.MoveDir }) | Destroyed p -> match World.tryGetEntity p world with | None -> world | Some target -> world |> World.removeEntity p |> World.appendAnimation (Destroying { DestroyedLoc = p DestroyedEntityType = target.EntityType }) module Loop = let tryGetAction key = match key with | ConsoleKey.RightArrow -> Move East |> Some | ConsoleKey.LeftArrow -> Move West |> Some | ConsoleKey.UpArrow -> Move North |> Some | ConsoleKey.DownArrow -> Move South |> Some | _ -> None let readPlayerActions() = seq { let mutable isRunning = true while isRunning do let key = Console.ReadKey().Key match tryGetAction key with | Some action -> yield action | None -> isRunning <- key <> ConsoleKey.Escape } let printWorld world = world |> World.format |> printfn "%s" let applyPlayerEvents action world = Action.getPlayerEvents action world |> Seq.fold Event.applyEvent world let getHostileMoveEvents p dm world = let dirs = Direction.all |> Seq.filter (fun dir -> let next = Direction.getNext p dir not (World.isOccupied next world)) |> Seq.toArray if dirs.Length = 0 then world else let nearestDir = dirs |> Seq.minBy (fun dir -> let next = Direction.getNext p dir DistanceMap.getDistance next dm) Moved { SourceLoc = p MoveDir = nearestDir } |> Event.applyEvent world let applyHostileEvents world = let targetLocs = World.getEntityLocations Rogue world let dm = World.getDistanceMap world targetLocs World.getEntityLocations Minion world |> Seq.sortBy (fun p -> DistanceMap.getDistance p dm) |> Seq.fold (fun state p -> getHostileMoveEvents p dm state) world let stepWorld world action = { world with Animations = List.empty } |> applyPlayerEvents action |> applyHostileEvents |> World.stepTurn let run world = readPlayerActions() |> Seq.scan stepWorld world |> Seq.iter printWorld ================================================ FILE: samples/Garnet.Samples.Roguelike/Game.fs ================================================ namespace Garnet.Samples.Roguelike open System open System.Numerics open System.Threading open Veldrid open Garnet.Numerics open Garnet.Composition open Garnet.Graphics open Garnet.Input module Resources = let tileTexture = "drake-10x10-transparent.png" let shaderSet : ShaderSetDescriptor = { VertexShader = "texture-dual-color.vert" FragmentShader = "texture-dual-color.frag" } // Use point sampling for pixelated appearance let pipeline = { Blend = Blend.Alpha Filtering = Filtering.Point ShaderSet = shaderSet Texture = tileTexture } // Avoid auto flush since we only update when an action occurs let tileLayer = { LayerId = 0 CameraId = 0 Primitive = Quad FlushMode = NoFlush Pipeline = pipeline } module Command = let getCommand = function | Key.R -> Command.Reset | Key.Right -> Command.MoveEast | Key.Up -> Command.MoveNorth | Key.Left -> Command.MoveWest | Key.Down -> Command.MoveSouth | Key.F11 -> Command.FullScreen | _ -> Command.None let tryGetAction = function | Command.MoveEast -> Move East |> Some | Command.MoveNorth -> Move North |> Some | Command.MoveWest -> Move West |> Some | Command.MoveSouth -> Move South |> Some | _ -> None [] module DrawingExtensions = type SpriteRenderer with member c.DrawWorld(world) = let tiles = c.GetVertices(Resources.tileLayer) tiles.DrawWorld(world) tiles.Flush() type Game(fs : IReadOnlyFolder) = // Image is a tilemap of ASCII chars (16x16=256 tiles) let image = fs.LoadImage(Resources.tileTexture) // Calculate window size to match map and tile size let tileScale = 2 let tileWidth = image.Width / 16 let tileHeight = image.Height / 16 let mapRadius = 15 let mapExtent = mapRadius * 2 + 1 // Create window and graphics device let ren = new WindowRenderer { WindowSettings.Default with Title = "Roguelike" Width = mapExtent * tileWidth * tileScale Height = mapExtent * tileHeight * tileScale Redraw = Redraw.Manual Background = RgbaFloat.Black } // Initialize rendering let shaders = new ShaderSetCache() let cache = new ResourceCache() let sprites = new SpriteRenderer(ren.Device, shaders, cache) do cache.AddShaderLoaders(ren.Device) fs.LoadShadersFromFolder(".", ren.Device.BackendType, cache) cache.AddResource(Resources.tileTexture, ren.Device.CreateTexture(image)) member c.Run() = // Set transforms so drawing code can use tile coords for source (16x16 tileset) // and destination (80x25 display tiles) let cameras = CameraSet() let texTileSize = 1.0f / 16.0f let camera = cameras.[0] camera.WorldTransform <- Matrix4x4.CreateScale(float32 tileWidth, float32 tileHeight, 1.0f) camera.TextureTransform <- Matrix4x4.CreateScale(texTileSize, texTileSize, 1.0f) // Start loop let inputs = InputCollection() let mutable state = World.generate mapRadius 1 sprites.DrawWorld(state) while ren.Update(0.0f, inputs) do for e in inputs.KeyDownEvents do match Command.getCommand e.KeyCode with | Command.FullScreen -> ren.ToggleFullScreen() | Command.None -> () | command -> match Command.tryGetAction command with | None -> () | Some action -> state <- Loop.stepWorld state action sprites.DrawWorld(state) // Note we only invalidate when something changes instead of every frame ren.Invalidate() if ren.BeginDraw() then // Update transforms according to window size so we can draw using pixel coords // with origin in upper left of view let displayScale = float32 tileScale let size = ren.Size.ToVector2() / displayScale camera.ProjectionTransform <- Matrix4x4.CreateOrthographic(size.X, -size.Y, -100.0f, 100.0f) camera.ViewTransform <- Matrix4x4.CreateTranslation(-size.X * 0.5f, -size.Y * 0.5f, 0.0f) sprites.Draw(ren.RenderContext, cameras) ren.EndDraw() // Sleep to avoid spinning CPU Thread.Sleep(1) interface IDisposable with member c.Dispose() = cache.Dispose() shaders.Dispose() sprites.Dispose() ren.Dispose() static member Run(fs) = use game = new Game(fs) game.Run() ================================================ FILE: samples/Garnet.Samples.Roguelike/Garnet.Samples.Roguelike.fsproj ================================================  WinExe net6.0 en true Link PreserveNewest PreserveNewest PreserveNewest ================================================ FILE: samples/Garnet.Samples.Roguelike/Program.fs ================================================ open Garnet.Composition open Garnet.Samples.Roguelike [] let main argv = use fs = new FileFolder("assets") Game.Run(fs) 0 ================================================ FILE: samples/Garnet.Samples.Roguelike/Types.fs ================================================ namespace Garnet.Samples.Roguelike [] module WorldTypes = type Vector = { X : int Y : int } type Bounds = { Min : Vector Max : Vector } type Direction = | East | West | North | South type DistanceMap = { Distances : Map } type Terrain = | Floor | Wall type EntityType = | Rogue | Minion type Entity = { EntityType : EntityType Hits : int } type Tile = { Terrain : Terrain Entity : Entity option } type Action = | Move of Direction type MovedEvent = { SourceLoc : Vector MoveDir : Direction } type AttackedEvent = { AttackerLoc : Vector AttackDir : Direction Damage : int } /// Events hold the minimal information needed to reconstruct world state type Event = | Moved of MovedEvent | Attacked of AttackedEvent | Destroyed of Vector type MovingEvent = { SourceLoc : Vector MoveDir : Direction } type AttackingAnimation = { AttackerLoc : Vector AttackerEntityType : EntityType AttackDir : Direction Damage : int TargetEntityType : EntityType } type DestroyingAnimation = { DestroyedLoc : Vector DestroyedEntityType : EntityType } /// Animations can enriched with extra info to help present events that occurred /// during a turn to the player type Animation = | Moving of MovingEvent | Attacking of AttackingAnimation | Destroying of DestroyingAnimation type World = { Turn : int RandomSeed : uint64 Tiles : Map Animations : Animation list } [] type Command = | None = 0 | MoveEast = 1 | MoveNorth = 2 | MoveWest = 3 | MoveSouth = 4 | Reset = 5 | FullScreen = 6 ================================================ FILE: samples/Garnet.Samples.Roguelike/assets/texture-dual-color.frag ================================================ #version 450 layout(location = 0) in vec2 fsin_texCoords; layout(location = 1) in vec4 fsin_fg; layout(location = 2) in vec4 fsin_bg; layout(location = 0) out vec4 fsout_color; layout(set = 1, binding = 2) uniform texture2D SurfaceTexture; layout(set = 1, binding = 3) uniform sampler SurfaceSampler; void main() { vec4 texColor = texture(sampler2D(SurfaceTexture, SurfaceSampler), fsin_texCoords); vec4 fg = fsin_fg; fg.rgb *= texColor.rgb; fsout_color = mix(fsin_bg, fg, texColor.a); } ================================================ FILE: samples/Garnet.Samples.Roguelike/assets/texture-dual-color.vert ================================================ #version 450 layout(set = 0, binding = 0) uniform ProjectionBuffer { mat4 Projection; }; layout(set = 0, binding = 1) uniform ViewBuffer { mat4 View; }; layout(set = 1, binding = 0) uniform WorldBuffer { mat4 World; }; layout(set = 1, binding = 1) uniform TexTransformBuffer { mat4 TexTransform; }; layout(location = 0) in vec3 Position; layout(location = 1) in vec2 TexCoords; layout(location = 2) in vec4 FgColor; layout(location = 3) in vec4 BgColor; layout(location = 0) out vec2 fsin_texCoords; layout(location = 1) out vec4 fsin_fg; layout(location = 2) out vec4 fsin_bg; void main() { vec4 worldPosition = World * vec4(Position, 1); vec4 viewPosition = View * worldPosition; vec4 clipPosition = Projection * viewPosition; gl_Position = clipPosition; fsin_texCoords = (TexTransform * vec4(TexCoords, 1, 1)).xy; fsin_fg = FgColor; fsin_bg = BgColor; } ================================================ FILE: samples/Garnet.Samples.Trixel/Drawing.fs ================================================ namespace Garnet.Samples.Trixel open System open System.Buffers open System.Runtime.CompilerServices open System.Numerics open Veldrid open Garnet.Numerics open Garnet.Graphics [] type VertexSpanExtensions = [] static member DrawLine(span : Span, p0 : Vector2, p1 : Vector2, thickness : float32, color : RgbaFloat) = let delta = p1 - p0 let length = delta.Length() let dir = if length < 1e-5f then Vector2.Zero else delta / length span.DrawQuad { Center = (p0 + p1) * 0.5f Size = Vector2(thickness, length) Rotation = dir.GetPerpendicular() TexBounds = Range2.ZeroToOne Color = color } [] static member DrawAxialLine(span : Span, p0 : Vector2i, p1 : Vector2i, thickness, color : RgbaFloat) = let ep0 = TriCoords.vertexToEuc p0 let ep1 = TriCoords.vertexToEuc p1 span.DrawLine(ep0, ep1, thickness, color) [] type VertexBufferWriterExtensions = [] static member DrawGridLines(w : IBufferWriter, spacing, thickness, color, r) = let extent = r / spacing let count = extent * 2 + 1 let span = w.GetQuadSpan(count * 3) for i = -extent to extent do let p = i * spacing let di = (i + extent) * 3 * 4 let p0 = Vector2i(-r, p) let p1 = Vector2i(r, p) span.Slice(di + 0).DrawAxialLine(p0, p1, thickness, color) let p0 = Vector2i(p, -r) let p1 = Vector2i(p, r) span.Slice(di + 4).DrawAxialLine(p0, p1, thickness, color) let p0 = Vector2i(-r, p + r) let p1 = Vector2i(r, p - r) span.Slice(di + 8).DrawAxialLine(p0, p1, thickness, color) w.Advance(span.Length) [] static member DrawGridLines(w : IBufferWriter, majorSpacing, majorThickness, majorColor, minorThickness, minorColor, r) = w.DrawGridLines(majorSpacing, majorThickness, majorColor, r) w.DrawGridLines(1, minorThickness, minorColor, r) [] static member DrawGridLines(w : IBufferWriter) = let minorColor = RgbaFloat(0.8f, 0.6f, 0.1f, 0.2f) let majorColor = RgbaFloat(0.8f, 0.6f, 0.1f, 0.3f) let majorSpacing = 6 let majorThickness = 0.1f let minorThickness = 0.05f w.DrawGridLines(majorSpacing, majorThickness, majorColor, minorThickness, minorColor, 100) [] static member DrawGridCells(w : IBufferWriter, state) = let cellMargin = 0.1f let vertexCount = state.Cells.Count * 3 let span = w.GetSpan(vertexCount) let mutable i = 0 for kvp in state.Cells do let p = Vector2i(kvp.Key.X, kvp.Key.Y) let tri = TriPositions.fromTriCell p let centroid = (tri.P0 + tri.P1 + tri.P2) / 3.0f let p0 = Vector2.Lerp(tri.P0, centroid, cellMargin) let p1 = Vector2.Lerp(tri.P1, centroid, cellMargin) let p2 = Vector2.Lerp(tri.P2, centroid, cellMargin) let color = kvp.Value.ToRgbaFloat() let verts = span.Slice(i * 3) verts.[0] <- { Position = Vector3(p0.X, p0.Y, 0.0f) TexCoord = Vector2(0.0f, 0.0f) Color = color } verts.[1] <- { Position = Vector3(p1.X, p1.Y, 0.0f) TexCoord = Vector2(1.0f, 0.0f) Color = color } verts.[2] <- { Position = Vector3(p2.X, p2.Y, 0.0f) TexCoord = Vector2(0.0f, 1.0f) Color = color } i <- i + 1 w.Advance(vertexCount) ================================================ FILE: samples/Garnet.Samples.Trixel/Functions.fs ================================================ namespace Garnet.Samples.Trixel open System open System.Numerics open Newtonsoft.Json open Garnet.Numerics open Veldrid module CellLocation = let origin = { X = 0; Y = 0 } module TriCoords = /// Height of an equilateral triangle with edge length one. Multiplier to determine simplex /// height given an edge length (sqrt(3/4) = 0.866025403784f). let edgeToHeight = 0.866025403784f /// Edge length of an equilateral triangle with height one. Multiplier to determine simplex /// edge length given a height (sqrt(4/3) = 1.154700538379f). let heightToEdge = 1.154700538379f let inline eucToVertexf (v : Vector2) = let y = -heightToEdge * v.Y let x = v.X - 0.5f * y Vector2(x, y) /// Rhombus/vertex to tri cell let inline vertexToTri (p : Vector2i) side = Vector2i(p.X * 2 + side, p.Y) /// Gets location of cell in tri coords that contains rhombus point. let vertexToContainingTriCell (p : Vector2) = let bx = floor p.X let by = floor p.Y let fx = p.X - bx let fy = p.Y - by let side = if fy < 1.0f - fx then 0 else 1 vertexToTri (Vector2i(int bx, int by)) side let eucToContainingTriCell = eucToVertexf >> vertexToContainingTriCell let inline vertexToEucf (v : Vector2) = Vector2(v.X + v.Y * 0.5f, v.Y * -edgeToHeight) let inline vertexToEuc (v : Vector2i) = v.ToVector2() |> vertexToEucf module UndoState = let init value = { Previous = [] Next = [] Current = value } module Command = let undo state = match state.Previous with | head :: tail -> { Previous = tail Next = state.Current :: state.Next Current = head } | _ -> state let redo state = match state.Next with | head :: tail -> { Previous = state.Current :: state.Previous Next = state.Next.Tail Current = state.Next.Head } | _ -> state let replace state value = { Previous = state.Current :: state.Previous Next = [] Current = value } let apply state cmd = match cmd with | Identity -> state | Undo -> undo state | Redo -> redo state | Replace c -> replace state c | Apply f -> replace state (f state.Current) module GridState = let empty = { Cells = Map.empty } let draw p color state = { state with Cells = Map.add p color state.Cells } let erase p state = { state with Cells = Map.remove p state.Cells } type SavedGrid = { cells : string list } let toHexString (c : RgbaByte) = let x = (int c.R <<< 24) ||| (int c.G <<< 16) ||| (int c.B <<< 8) ||| (int c.A <<< 0) $"%08x{x}" let serialize (state : GridState) = JsonConvert.SerializeObject({ cells = state.Cells |> Seq.sortBy (fun kvp -> kvp.Key.Y, kvp.Key.X) |> Seq.map (fun kvp -> $"%d{kvp.Key.X} %d{kvp.Key.Y} %s{toHexString kvp.Value}") |> Seq.toList }, Formatting.Indented) /// RGBA from high to low bits let uint32ToRgbaByte (x : uint32) = RgbaByte( byte ((x >>> 24) &&& (uint32 0xff)), byte ((x >>> 16) &&& (uint32 0xff)), byte ((x >>> 8) &&& (uint32 0xff)), byte ((x >>> 0) &&& (uint32 0xff))) let parseRgbaHex str = UInt32.Parse(str, Globalization.NumberStyles.HexNumber) |> uint32ToRgbaByte let deserialize str = let g = JsonConvert.DeserializeObject(str) { GridState.Cells = g.cells |> Seq.map (fun c -> let parts = c.Split(' ') { X = Int32.Parse(parts.[0]); Y = Int32.Parse(parts.[1]) }, parseRgbaHex parts.[2]) |> Map.ofSeq } let sample param (grid : GridState) = let w = max 0 param.OutputWidth let h = max 0 param.OutputHeight let r = param.Bounds let s = max 1 param.SampleFactor let samplesPerPixel = s * s let data = Array.zeroCreate (w * h * 4) // uniform supersampling of pixels // |.....x.....|.....x.....| // |..x.....x..|..x.....x..| for y = 0 to h - 1 do for x = 0 to w - 1 do let mutable sr = 0 let mutable sg = 0 let mutable sb = 0 let mutable sa = 0 for sy = 0 to s - 1 do for sx = 0 to s - 1 do let nx = (float32 (x * s + sx) + 0.5f) / float32 (w * s) let ny = (float32 (y * s + sy) + 0.5f) / float32 (h * s) let np = Vector2(nx, ny) let ep = Range2.Lerp(r, np) let cp = TriCoords.eucToContainingTriCell ep let color = let cp = { X = cp.X; Y = cp.Y } match grid.Cells.TryGetValue(cp) with | false, _ -> param.Background | true, x -> x sr <- sr + int color.R sg <- sg + int color.G sb <- sb + int color.B sa <- sa + int color.A // reverse y for texture let i = (h - 1 - y) * w + x data.[i * 4 + 0] <- sr / samplesPerPixel |> byte data.[i * 4 + 1] <- sg / samplesPerPixel |> byte data.[i * 4 + 2] <- sb / samplesPerPixel |> byte data.[i * 4 + 3] <- sa / samplesPerPixel |> byte data module Viewport = let getViewSize zoom width height = let tileSize = 24.0f let aspect = float32 width / float32 height let widthInTiles = float32 width / tileSize let heightInTiles = widthInTiles / aspect let scale = MathF.Pow(2.0f, float32 -zoom * 0.5f) |> float32 Vector2(widthInTiles, heightInTiles) * scale let getInverseOrIdentity (m : Matrix4x4) = let mutable mInv = Matrix4x4.Identity if Matrix4x4.Invert(m, &mInv) then mInv else Matrix4x4.Identity module TriPositions = let inline fromTriCellScaled (tileSize : Vector2) (p : Vector2i) = let y0 = float32 p.Y let y1 = float32 (p.Y + 1) let py0 = Vector2(y0 * 0.5f, y0 * -tileSize.Y) let py1 = Vector2(y1 * 0.5f, y1 * -tileSize.Y) let ax = p.X >>> 1 let x0 = float32 ax let x1 = float32 (ax + 1) let p01 = Vector2((py1.X + x0) * tileSize.X, py1.Y) let p10 = Vector2((py0.X + x1) * tileSize.X, py0.Y) let side = p.X &&& 1 if side = 0 then { P0 = Vector2((py0.X + x0) * tileSize.X, py0.Y); P1 = p10; P2 = p01 } else { P0 = Vector2((py1.X + x1) * tileSize.X, py1.Y); P1 = p01; P2 = p10 } let inline fromTriCell (p : Vector2i) = fromTriCellScaled (Vector2(1.0f, TriCoords.edgeToHeight)) p ================================================ FILE: samples/Garnet.Samples.Trixel/Game.fs ================================================ namespace Garnet.Samples.Trixel open System open System.Numerics open System.Threading open System.IO open Veldrid open SixLabors.ImageSharp open Garnet.Numerics open Garnet.Composition open Garnet.Graphics open Garnet.Input module Resources = let squareTex = "square.png" let shaderSet : ShaderSetDescriptor = { VertexShader = "texture-color.vert" FragmentShader = "texture-color.frag" } let pipeline = { Blend = Blend.Alpha Filtering = Filtering.Linear ShaderSet = shaderSet Texture = squareTex } let cellLayer = { LayerId = 4 CameraId = 0 Primitive = Triangle FlushMode = NoFlush Pipeline = pipeline } let gridLineLayer = { LayerId = 3 CameraId = 0 Primitive = Quad FlushMode = NoFlush Pipeline = pipeline } [] module DrawingExtensions = type SpriteRenderer with member c.DrawGrid(state) = let mesh = c.GetVertices(Resources.cellLayer) mesh.DrawGridCells(state.Current) mesh.Flush() type Game(fs : IReadOnlyFolder) = // Create window and graphics device let ren = new WindowRenderer { WindowSettings.Default with Title = "Trixel" Width = 800 Height = 600 Background = RgbaFloat(0.0f, 0.1f, 0.2f, 1.0f) } // Initialize rendering let shaders = new ShaderSetCache() let cache = new ResourceCache() let sprites = new SpriteRenderer(ren.Device, shaders, cache) let gui = new Gui(ren.Device, ren.ImGui) do cache.AddShaderLoaders(ren.Device) fs.LoadShadersFromFolder(".", ren.Device.BackendType, cache) fs.LoadTexture(ren.Device, Resources.squareTex, cache) member c.Run() = let mutable state = UndoState.init GridState.empty sprites.DrawGrid(state) // Grid lines let mesh = sprites.GetVertices(Resources.gridLineLayer) mesh.DrawGridLines() mesh.Flush() // Cells let mesh = sprites.GetVertices(Resources.cellLayer) mesh.DrawGridCells(state.Current) mesh.Flush() // Start loop let inputs = InputCollection() let cameras = CameraSet() while ren.Update(0.0f, inputs) do // Calculate transforms let sizeInTiles = Viewport.getViewSize 0 ren.Size.X ren.Size.Y let proj = Matrix4x4.CreateOrthographic(sizeInTiles.X, sizeInTiles.Y, -100.0f, 100.0f) let view = Matrix4x4.Identity let camera = cameras.[0] camera.ProjectionTransform <- proj camera.ViewTransform <-view // Draw GUI and collect any user command let projView = proj * view let invProjView = Viewport.getInverseOrIdentity projView let result = gui.Draw(state, inputs, invProjView) // Apply command to state or read/write files match result with | None -> () | Some cmd -> match cmd with | GridCommand cmd -> // Update state from command state <- Command.apply state cmd sprites.DrawGrid(state) | Export cmd -> let image = Image.createRenderedGridImage cmd.SamplingParams state.Current use fs = File.OpenWrite(cmd.ExportFile) image.SaveAsPng(fs) | FileCommand cmd -> match cmd with | Load file -> let cmd = File.ReadAllText(file) |> GridState.deserialize |> Replace state <- Command.apply state cmd sprites.DrawGrid(state) | Save file -> Directory.CreateDirectory(Path.GetDirectoryName(file)) |> ignore File.WriteAllText(file, GridState.serialize state.Current) // Draw to window if ren.BeginDraw() then sprites.Draw(ren.RenderContext, cameras) ren.EndDraw() // Sleep to avoid spinning CPU Thread.Sleep(1) interface IDisposable with member c.Dispose() = cache.Dispose() shaders.Dispose() sprites.Dispose() gui.Dispose() ren.Dispose() static member Run(fs) = use game = new Game(fs) game.Run() ================================================ FILE: samples/Garnet.Samples.Trixel/Garnet.Samples.Trixel.fsproj ================================================  WinExe net6.0 en true Link Garnet.Samples.Trixel PreserveNewest PreserveNewest PreserveNewest PreserveNewest PreserveNewest ================================================ FILE: samples/Garnet.Samples.Trixel/Gui.fs ================================================ namespace Garnet.Samples.Trixel open System open System.IO open System.Numerics open Veldrid open ImGuiNET open Garnet.Numerics open Garnet.Input type CursorGui() = member c.Draw(inputs : InputCollection, invProjView : Matrix4x4) = let pos = ImGui.GetMousePos() let normPos = inputs.NormalizedMousePosition let viewPos = Vector2.Transform(normPos, invProjView) let cellPos = TriCoords.eucToContainingTriCell viewPos ImGui.Text($"Position: {pos}") ImGui.Text($"Normalized: {normPos}") ImGui.Text($"Viewport: {viewPos}") ImGui.Text($"Cell: {cellPos}") ImGui.Text($"Buttons: {inputs.IsMouseDown(0)} {inputs.IsMouseDown(1)}") type ViewGui() = let mutable centerX = 35 let mutable centerY = -18 let mutable cellMargin = 0.1f let mutable zoom = 0 member c.Draw(state : UndoState) = let grid = state.Current ImGui.Text($"Cells: {grid.Cells.Count}") let inv = false let inv = ImGui.InputInt("Zoom", &zoom) || inv let inv = ImGui.InputInt("X", ¢erX) || inv let inv = ImGui.InputInt("Y", ¢erY) || inv () type EditGui() = let mutable primary = Vector4(0.5f, 0.0f, 0.3f, 1.0f) let mutable secondary = Vector4(0.3f, 0.0f, 0.6f, 1.0f) member c.Draw(state : UndoState, inputs : InputCollection, invProjView : Matrix4x4) = if ImGui.Begin("Edit") then ImGui.ColorEdit4("Primary", &primary) |> ignore ImGui.ColorEdit4("Secondary", &secondary) |> ignore let undo = ImGui.Button $"Undo (%d{state.Previous.Length})" let redo = ImGui.Button $"Redo (%d{state.Next.Length})" let leftButton = inputs.IsMouseDown(0) let rightButton = inputs.IsMouseDown(2) let drawCommand = let canDraw = not (ImGui.GetIO().WantCaptureMouse) && (leftButton || rightButton) if canDraw then let normPos = inputs.NormalizedMousePosition let viewPos = Vector2.Transform(normPos, invProjView) let modifiers = inputs.Modifiers let p = TriCoords.eucToContainingTriCell viewPos let cp = { X = p.X; Y = p.Y } let current = state.Current let newState = if leftButton then let v = if modifiers.HasShift() then secondary else primary let color = RgbaFloat(v.X, v.Y, v.Z, v.W).ToRgbaByte() GridState.draw cp color current else GridState.erase cp current if newState <> current then Some (Replace newState) else None else None let result = if drawCommand.IsSome then drawCommand elif undo then Some Undo elif redo then Some Redo else None ImGui.End() result else None type PreviewGui(device : GraphicsDevice, renderer : ImGuiRenderer) = let previewTex = new PreviewTexture(device, renderer) let mutable zoom = 8 let mutable width = 35 let mutable height = 30 let mutable centerX = 0 let mutable centerY = 0 let mutable multisample = 4 let mutable viewSize = 30 let mutable resolution = 1 let mutable file = "preview.png" member c.Draw(state : GridState) = if ImGui.Begin("Preview") then ImGui.InputInt("Zoom", &zoom) |> ignore ImGui.InputInt("View size", &viewSize) |> ignore ImGui.InputInt("Width", &width) |> ignore ImGui.InputInt("Height", &height) |> ignore ImGui.InputInt("Multiplier", &resolution) |> ignore ImGui.InputInt("X", ¢erX) |> ignore ImGui.InputInt("Y", ¢erY) |> ignore ImGui.InputInt("Multisample", &multisample) |> ignore ImGui.InputText("File", &file, 128u) |> ignore let export = ImGui.Button("Export") let viewWidth = float32 viewSize let viewHeight = viewWidth * TriCoords.edgeToHeight let center = TriCoords.vertexToEuc (Vector2i(centerX, centerY)) let param = { OutputWidth = width * resolution OutputHeight = height * resolution SampleFactor = multisample Bounds = Range2.Sized(center, Vector2(viewWidth, viewHeight)) Background = RgbaByte.Black } previewTex.Draw(param, state, zoom, resolution) ImGui.End() if export then Some { ExportFile = file SamplingParams = param } else None else None member c.Dispose() = previewTex.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type FileGui() = let filter = "*.json" let mutable dir = @"trixel-grids" let mutable file = "" let mutable files = [||] let mutable fileIndex = 0 let mutable filesValid = false member c.Draw() = if ImGui.Begin("File") then if ImGui.Button("Refresh") then filesValid <- false if ImGui.InputText("Folder", &dir, 128u) || not filesValid then files <- if Directory.Exists(dir) then Directory.GetFiles(dir, filter) |> Array.map Path.GetFileName else [||] fileIndex <- 0 filesValid <- true if ImGui.ListBox("", &fileIndex, files, files.Length) then file <- if fileIndex < files.Length then files.[fileIndex] else "" let load = if ImGui.Button("Load") && file.Length > 0 then let path = Path.Combine(dir, file) Some (Load path) else None let save = ImGui.InputText("File", &file, 128u) |> ignore if ImGui.Button("Save") && file.Length > 0 then let path = Path.Combine(dir, file) Some (Save path) else None let result = if load.IsSome then load else save ImGui.End() result else None type StatusGui() = let cursorGui = CursorGui() let viewGui = ViewGui() member c.Draw(state, inputs, invProjView) = if ImGui.Begin("Status") then cursorGui.Draw(inputs, invProjView) viewGui.Draw(state) ImGui.End() type Gui(device : GraphicsDevice, renderer : ImGuiRenderer) = let fileGui = FileGui() let editGui = EditGui() let previewGui = new PreviewGui(device, renderer) let statusGui = StatusGui() member c.Draw(state, inputs, invProjView) = // draw GUI statusGui.Draw(state, inputs, invProjView) let editCommand = editGui.Draw(state, inputs, invProjView) let fileCommand = fileGui.Draw() let previewCommand = previewGui.Draw(state.Current) // resolve command if editCommand.IsSome then Some (GridCommand editCommand.Value) elif previewCommand.IsSome then Some (Export previewCommand.Value) elif fileCommand.IsSome then Some (FileCommand fileCommand.Value) else None member c.Dispose() = previewGui.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Samples.Trixel/Imaging.fs ================================================ namespace Garnet.Samples.Trixel open System open System.Numerics open SixLabors.ImageSharp open Veldrid open ImGuiNET open Garnet.Graphics module Image = let createRenderedGridImage param state = let data = GridState.sample param state let rgbaData = Array.zeroCreate (data.Length / 4) for i = 0 to rgbaData.Length - 1 do rgbaData.[i] <- PixelFormats.Rgba32( data.[i * 4], data.[i * 4 + 1], data.[i * 4 + 2], data.[i * 4 + 3]) Image.WrapMemory(Memory(rgbaData), param.OutputWidth, param.OutputHeight) type PreviewTexture(device : GraphicsDevice, renderer : ImGuiRenderer) = let mutable texture : Texture = null let mutable lastState = GridState.empty let mutable lastParam = Unchecked.defaultof member c.Draw(param, state, zoom, resolution) = let canUpdate = lastParam <> param || lastState <> state || texture = null if canUpdate then if texture <> null then texture.Dispose() let data = GridState.sample param state texture <- device.CreateTextureRgba(param.OutputWidth, param.OutputHeight, ReadOnlyMemory(data)) if texture <> null then let texId = renderer.GetOrCreateImGuiBinding(device.ResourceFactory, texture) let width = float32 (int texture.Width * zoom / resolution |> max 1) let height = float32 (int texture.Height * zoom / resolution |> max 1) ImGui.Image(texId, Vector2(width, height)) member c.Dispose() = if texture <> null then texture.Dispose() texture <- null interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Samples.Trixel/Program.fs ================================================ open Garnet.Composition open Garnet.Samples.Trixel [] let main argv = use fs = new FileFolder("assets") Game.Run(fs) 0 ================================================ FILE: samples/Garnet.Samples.Trixel/Types.fs ================================================ namespace Garnet.Samples.Trixel open System.Numerics open Garnet.Numerics open Veldrid [] module Grids = [] type CellLocation = { X : int Y : int } type GridState = { Cells : Map } type GridStateChanged = { NewGridState : GridState } [] type SamplingParams = { OutputWidth : int OutputHeight : int SampleFactor : int Bounds : Range2 Background : RgbaByte } type GridLineState = { LineSpacing : int } type ViewportSize = { ViewportSize : int } [] type TriPositions = { P0 : Vector2 P1 : Vector2 P2 : Vector2 } [] module Commands = type Command<'a> = | Identity | Undo | Redo | Replace of 'a | Apply of ('a -> 'a) type UndoState<'a> = { Previous : 'a list Next : 'a list Current : 'a } type FileCommand = | Load of string | Save of string type ExportCommand = { ExportFile : string SamplingParams : SamplingParams } type Command = | Export of ExportCommand | FileCommand of FileCommand | GridCommand of Command ================================================ FILE: samples/Garnet.Samples.Trixel/assets/texture-color.frag ================================================ #version 450 layout(location = 0) in vec2 fsin_texCoords; layout(location = 1) in vec4 fsin_color; layout(location = 0) out vec4 fsout_color; layout(set = 1, binding = 1) uniform texture2D SurfaceTexture; layout(set = 1, binding = 2) uniform sampler SurfaceSampler; void main() { vec4 texColor = texture(sampler2D(SurfaceTexture, SurfaceSampler), fsin_texCoords); fsout_color = texColor * fsin_color; } ================================================ FILE: samples/Garnet.Samples.Trixel/assets/texture-color.frag.hlsl.bytes ================================================ Texture2D _12 : register(t0); SamplerState _16 : register(s0); static float2 _22; static float4 _26; static float4 _29; struct SPIRV_Cross_Input { float2 _22 : TEXCOORD0; float4 _29 : TEXCOORD1; }; struct SPIRV_Cross_Output { float4 _26 : SV_Target0; }; void frag_main() { _26 = _12.Sample(_16, _22) * _29; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _22 = stage_input._22; _29 = stage_input._29; frag_main(); SPIRV_Cross_Output stage_output; stage_output._26 = _26; return stage_output; } ================================================ FILE: samples/Garnet.Samples.Trixel/assets/texture-color.vert ================================================ #version 450 layout(set = 0, binding = 0) uniform ProjectionBuffer { mat4 Projection; }; layout(set = 0, binding = 1) uniform ViewBuffer { mat4 View; }; layout(set = 1, binding = 0) uniform WorldBuffer { mat4 World; }; layout(location = 0) in vec3 Position; layout(location = 1) in vec2 TexCoords; layout(location = 2) in vec4 Color; layout(location = 0) out vec2 fsin_texCoords; layout(location = 1) out vec4 fsin_Color; void main() { vec4 worldPosition = World * vec4(Position, 1); vec4 viewPosition = View * worldPosition; vec4 clipPosition = Projection * viewPosition; gl_Position = clipPosition; fsin_texCoords = TexCoords; fsin_Color = Color; } ================================================ FILE: samples/Garnet.Samples.Trixel/assets/texture-color.vert.hlsl.bytes ================================================ cbuffer _11_13 : register(b2) { row_major float4x4 _13_m0 : packoffset(c0); }; cbuffer _30_32 : register(b1) { row_major float4x4 _32_m0 : packoffset(c0); }; cbuffer _38_40 : register(b0) { row_major float4x4 _40_m0 : packoffset(c0); }; static float4 gl_Position; static float3 _21; static float2 _56; static float2 _58; static float4 _60; static float4 _62; struct SPIRV_Cross_Input { float3 _21 : TEXCOORD0; float2 _58 : TEXCOORD1; float4 _62 : TEXCOORD2; }; struct SPIRV_Cross_Output { float2 _56 : TEXCOORD0; float4 _60 : TEXCOORD1; float4 gl_Position : SV_Position; }; void vert_main() { gl_Position = mul(mul(mul(float4(_21, 1.0f), _13_m0), _32_m0), _40_m0); _56 = _58; _60 = _62; } SPIRV_Cross_Output main(SPIRV_Cross_Input stage_input) { _21 = stage_input._21; _58 = stage_input._58; _62 = stage_input._62; vert_main(); SPIRV_Cross_Output stage_output; stage_output.gl_Position = gl_Position; stage_output._56 = _56; stage_output._60 = _60; return stage_output; } ================================================ FILE: samples/Garnet.Toolkit/Audio.fs ================================================ namespace Garnet.Audio open System open System.Buffers open System.Collections.Generic open System.Numerics open System.IO open System.Runtime.InteropServices open OpenTK.Audio.OpenAL open OpenTK.Audio.OpenAL.Extensions open Garnet.Composition open Garnet.Collections [] type SoundId = SoundId of int [] type SoundDescriptor = { Channels : int BitsPerSample : int SampleRate : int SampleCount : int } [] type SoundPlayback = { LoopCount : int Gain : float32 Pitch : float32 Position : Vector3 Relative : bool } with static member Default = { LoopCount = 1 Gain = 1.0f Pitch = 1.0f Position = Vector3.Zero Relative = false } module SoundDescriptor = let getALFormat desc = if desc.Channels = 1 && desc.BitsPerSample = 8 then ALFormat.Mono8 elif desc.Channels = 1 && desc.BitsPerSample = 16 then ALFormat.Mono16 elif desc.Channels = 2 && desc.BitsPerSample = 8 then ALFormat.Stereo8 elif desc.Channels = 2 && desc.BitsPerSample = 16 then ALFormat.Stereo16 else failwith $"Unsupported audio format, {desc.Channels} channels, {desc.BitsPerSample} bits" let getDuration desc = (desc.SampleCount * 1000 + 999) / desc.Channels / desc.SampleRate [] module internal OpenALInternal = module SoundId = let toInt id = match id with SoundId x -> x type AL = static member GetAvailableDeviceNames() = [| yield! ALC.GetStringList(GetEnumerationStringList.DeviceSpecifier) yield! Creative.EnumerateAll.EnumerateAll.GetStringList(Creative.EnumerateAll.GetEnumerateAllContextStringList.AllDevicesSpecifier) |] static member ThrowIfError(str) = let error = AL.GetError() if int error <> int ALError.NoError then failwith $"OpenAL error on {str}: {AL.GetErrorString(error)}" type internal SourcePool() = let maxSources = 32 let sources = AL.GenSources(maxSources) let pool = let stack = Stack() for id in sources do stack.Push(id) stack member c.TryGetSource() = if pool.Count > 0 then ValueSome (pool.Pop()) else ValueNone member c.RecycleSource(id) = pool.Push(id) member c.Dispose() = AL.DeleteSources(sources) interface IDisposable with member c.Dispose() = c.Dispose() [] type Sound = { descriptor : SoundDescriptor buffer : int } type AudioDevice() = let devices = AL.GetAvailableDeviceNames() let device = ALC.OpenDevice(null) let context = let c = ALC.CreateContext(device, Array.empty) let _ = ALC.MakeContextCurrent(c) c let sources = new SourcePool() let sounds = List() let activeSources = PriorityQueue() let mutable scale = 1.0f let mutable time = 0L member c.CreateSound(desc, data : ReadOnlyMemory) = let buffers = AL.GenBuffers(1) use handle = data.Pin() let format = SoundDescriptor.getALFormat desc AL.BufferData(buffers.[0], format, IntPtr handle.Pointer, desc.SampleCount, desc.SampleRate) AL.ThrowIfError("loading audio data") let sound = { descriptor = desc buffer = buffers.[0] } let soundId = sounds.Count sounds.Add(sound) SoundId soundId member c.StopSounds() = while activeSources.Count > 0 do let sourceId = activeSources.Dequeue() AL.SourceStop(sourceId) sources.RecycleSource(sourceId) member c.Update(currentTime) = time <- currentTime while activeSources.Count > 0 && currentTime >= activeSources.Top.Key do let sourceId = activeSources.Dequeue() AL.SourceStop(sourceId) sources.RecycleSource(sourceId) member c.PlaySound(soundId, playback : SoundPlayback) = match sources.TryGetSource() with | ValueNone -> () | ValueSome sourceId -> let soundId = SoundId.toInt soundId let sound = sounds.[soundId] let p = playback.Position * scale AL.Source(sourceId, ALSourcei.Buffer, sound.buffer) AL.Source(sourceId, ALSourceb.Looping, playback.LoopCount > 1) AL.Source(sourceId, ALSourcef.Pitch, playback.Pitch) AL.Source(sourceId, ALSourcef.Gain, playback.Gain) AL.Source(sourceId, ALSourceb.SourceRelative, playback.Relative) AL.Source(sourceId, ALSource3f.Position, p.X, p.Y, p.Z) AL.SourcePlay(sourceId) let duration = SoundDescriptor.getDuration sound.descriptor * playback.LoopCount activeSources.Enqueue(time + int64 duration, sourceId) member c.SetPosition(pos : Vector3) = let mutable v = OpenTK.Mathematics.Vector3(pos.X, pos.Y, pos.Z) * scale AL.Listener(ALListener3f.Position, &v) member c.SetGain(gain) = AL.Listener(ALListenerf.Gain, gain) member c.SetScaling(newScale) = scale <- newScale member c.Dispose() = c.StopSounds() sources.Dispose() for sound in sounds do AL.DeleteBuffers([| sound.buffer |]) ALC.MakeContextCurrent(ALContext.Null) |> ignore ALC.DestroyContext(context) ALC.CloseDevice(device) |> ignore interface IDisposable with member c.Dispose() = c.Dispose() override c.ToString() = let version = AL.Get(ALGetString.Version) let vendor = AL.Get(ALGetString.Vendor) let renderer = AL.Get(ALGetString.Renderer) sprintf "Audio devices (%d):\n %s\nSelected device:\n %s\n %s\n %s" devices.Length (String.Join("\n ", devices)) renderer version vendor type AudioDevice with member c.CreateSoundFromSineWave() = let sampleRate = 44100 let dt = 2.0 * Math.PI / float sampleRate let amp = 0.5 let freq = 440.0 let sampleCount = float sampleRate / freq let data = Array.zeroCreate (int sampleCount * 2) let dest = MemoryMarshal.Cast(data.AsSpan()) for i = 0 to dest.Length - 1 do dest.[i] <- int16 (amp * float Int16.MaxValue * sin (float i * dt * freq)) let desc = { Channels = 1 BitsPerSample = 16 SampleRate = sampleRate SampleCount = data.Length * 8 / 16 } c.CreateSound(desc, ReadOnlyMemory(data)) [] module AudioLoadingExtensions = type IStreamSource with member c.LoadWave(device : AudioDevice, key) = use stream = c.Open(key) // https://stackoverflow.com/questions/8754111/how-to-read-the-data-in-a-wav-file-to-an-array use reader = new BinaryReader(stream) // chunk 0 let _ = reader.ReadInt32() // chunkId let _ = reader.ReadInt32() // fileSize let _ = reader.ReadInt32() // riffType // chunk 1 let _ = reader.ReadInt32() // fmtID let fmtSize = reader.ReadInt32() // bytes for this chunk (expect 16 or 18) // 16 bytes coming let _ = int (reader.ReadInt16()) // fmtCode let channels = int (reader.ReadInt16()) let sampleRate = reader.ReadInt32() let _ = reader.ReadInt32() // byteRate let _ = int (reader.ReadInt16()) // fmtBlockAlign let bitDepth = int (reader.ReadInt16()) if fmtSize = 18 then // Read any extra values let fmtExtraSize = int (reader.ReadInt16()) stream.Seek(int64 fmtExtraSize, SeekOrigin.Current) |> ignore // Skip to data chunk let dataTag = 0x61_74_61_64 // 'data' let mutable tag = reader.ReadInt32() let mutable length = reader.ReadInt32() while tag <> dataTag do // Read instead of seeking since zip stream doesn't support seek let buffer = ArrayPool.Shared.Rent(length) reader.BaseStream.Read(buffer, 0, length) |> ignore ArrayPool.Shared.Return(buffer) // Read next header tag <- reader.ReadInt32() length <- reader.ReadInt32() // Read data // https://stackoverflow.com/questions/10996917/openal-albufferdata-returns-al-invalid-value-even-though-input-variables-look let adjustedLength = (length + 3) / 4 * 4 let data = ArrayPool.Shared.Rent(adjustedLength) stream.Read(data, 0, length) |> ignore // Create descriptor let bytesPerSample = bitDepth / 8 let sampleCount = adjustedLength / bytesPerSample let desc = { Channels = channels BitsPerSample = bitDepth SampleRate = sampleRate SampleCount = sampleCount } try let sound = device.CreateSound(desc, ReadOnlyMemory(data, 0, adjustedLength)) ArrayPool.Shared.Return(data) sound with ex -> raise (Exception($"Could not load WAV file '{key}'", ex)) type IReadOnlyFolder with member c.LoadAudioFromFolder(path, device, cache : IResourceCache) = for file in c.GetFiles(path, "*.wav") do let soundId = c.LoadWave(device, file) cache.AddResource(file, soundId) type WaveFileLoader(device : AudioDevice) = interface IResourceLoader with member c.Load(folder, cache, key) = cache.AddResource(key, folder.LoadWave(device, key)) [] module AudioLoaderExtensions = type ResourceCache with member c.AddAudioLoaders(device) = c.AddLoader(".wav", WaveFileLoader(device)) ================================================ FILE: samples/Garnet.Toolkit/Collections.fs ================================================ namespace Garnet.Collections open System open System.Collections.Generic open Garnet.Comparisons /// Mutable min-heap type Heap<'k, 'a when 'k :> IComparable<'k>>() = // create a dummy value for easier indexing let items = List>() do items.Add(Unchecked.defaultof<_>) let compare a b = items.[a].Key.CompareTo(items.[b].Key) let swap a b = let temp = items.[b] items.[b] <- items.[a] items.[a] <- temp let getMinChildIndex parentIndex = let ci = parentIndex * 2 if ci >= items.Count then -1 else // if we have a second child that's smaller, pick it // we know that if second exists, first exists due to shape let offset = if ci + 1 < items.Count && compare (ci + 1) ci < 0 then 1 else 0 ci + offset let rec siftDown index = // start at top and swap down through min child let ci = getMinChildIndex index if ci >= 0 && compare index ci > 0 then swap index ci siftDown ci let rec siftUp index = // start at end and swap up through parent // maintain parent/child invariant at each iteration if index > 1 && compare index (index / 2) < 0 then swap index (index / 2) siftUp (index / 2) member h.Count = items.Count - 1 member h.Top = items.[1] member h.Insert(key, value) = items.Add(KeyValuePair(key, value)) siftUp (items.Count - 1) member h.RemoveMin() = if h.Count = 0 then failwith "Heap is empty" let top = h.Top items.[1] <- items.[items.Count - 1] items.RemoveAt(items.Count - 1) siftDown 1 top member h.Clear() = while items.Count > 1 do items.RemoveAt(items.Count - 1) /// Mutable, min queue (min priority value dequeued first) type PriorityQueue<'k, 'a when 'k :> IComparable<'k>>() = let heap = Heap<'k, 'a>() member _.Count = heap.Count member _.Top = heap.Top member _.Enqueue(priority, value) = heap.Insert(priority, value) member _.Dequeue() = heap.RemoveMin().Value member _.Clear() = heap.Clear() module internal Buffer = let private log2 x = let mutable log = 0 let mutable y = x while y > 1 do y <- y >>> 1 log <- log + 1; log let private nextLog2 x = let log = log2 x if x - (1 <<< log) > 0 then 1 + log else log let getRequiredCount count = 1 <<< nextLog2 count let resizeArray count (arr : byref<_[]>) = if isNull arr || count > arr.Length then let required = 1 <<< nextLog2 count let newArr = Array.zeroCreate required if isNotNull arr then arr.CopyTo(newArr, 0) arr <- newArr ================================================ FILE: samples/Garnet.Toolkit/Colors.fs ================================================ namespace Garnet.Numerics open System open Veldrid module private ColorParsing = let parse defaultValue (parts : string[]) index = if index >= parts.Length then defaultValue else match Single.TryParse(parts.[index]) with | true, x -> x | false, _ -> defaultValue [] type HsvaFloat = val H : float32 val S : float32 val V : float32 val A : float32 new(h, s, v, a) = { H = h; S = s; V = v; A = a; } new(c : RgbaFloat) = let m = min (min c.R c.G) c.B let v = max (max c.R c.G) c.B let s = if v > Single.Epsilon then 1.0f - m / v else 0.0f let l = (m + v) / 2.0f if l < Single.Epsilon || v < m then HsvaFloat(0.0f, s, v, c.A) else let vm = v - m let r2 = (v - c.R) / vm let g2 = (v - c.G) / vm let b2 = (v - c.B) / vm let hx = if c.R = v then if c.G = m then 5.0f + b2 else 1.0f - g2 else if c.G = v then if c.B = m then 1.0f + r2 else 3.0f - b2 else if c.R = m then 3.0f + g2 else 5.0f - r2 / 6.0f let h = if hx >= 1.0f then hx - 1.0f else hx HsvaFloat(h, s, v, c.A) member c.ShiftHue(shift) = HsvaFloat(c.H + shift, c.S, c.V, c.A) member c.ToRgbaFloat() = // from: http://alvyray.com/Papers/CG/hsv2rgb.htm // H is given on [0, 6] or UNDEFINED. S and V are given on [0, 1]. // RGB are each returned on [0, 1]. let f = c.H - floor c.H let h = f * 6.0f let v = c.V let i = int32(floor h) // if i is even let g = if (i &&& 1) = 0 then 1.0f - f else f let m = v * (1.0f - c.S) let n = v * (1.0f - c.S * g) match i with | 6 -> RgbaFloat(v, n, m, c.A) | 0 -> RgbaFloat(v, n, m, c.A) | 1 -> RgbaFloat(n, v, m, c.A) | 2 -> RgbaFloat(m, v, n, c.A) | 3 -> RgbaFloat(m, n, v, c.A) | 4 -> RgbaFloat(n, m, v, c.A) | _ -> RgbaFloat(v, m, n, c.A) static member Lerp(min : HsvaFloat, max : HsvaFloat, t) = HsvaFloat( MathF.Lerp(min.H, max.H, t), MathF.Lerp(min.S, max.S, t), MathF.Lerp(min.V, max.V, t), MathF.Lerp(min.A, max.A, t)) static member Parse(str : string) = // hsva(120,100%,50%,0.3) let parts = str.Replace(" ", "").Replace("%", "").Split([|','; '('; ')'|], StringSplitOptions.RemoveEmptyEntries) let h = ColorParsing.parse 0.0f parts 1 / 360.0f let s = ColorParsing.parse 0.0f parts 2 / 100.0f let v = ColorParsing.parse 0.0f parts 3 / 100.0f let a = ColorParsing.parse 1.0f parts 4 HsvaFloat(h, s, v, a) [] type HslaFloat = val H : float32 val S : float32 val L : float32 val A : float32 new(h, s, l, a) = { H = h; S = s; L = l; A = a; } new(c : RgbaFloat) = let c0 = min (min c.R c.G) c.B let c1 = max (max c.R c.G) c.B let l = (c0 + c1) / 2.0f if c0 = c1 then HslaFloat(0.0f, 0.0f, l, c.A) else let delta = c1 - c0 let s = if l <= 0.5f then (delta / (c1 + c0)) else (delta / (2.0f - (c1 + c0))) let h = if c.R = c1 then (c.G - c.B) / delta else if c.G = c1 then 2.0f + (c.B - c.R) / delta else if c.B = c1 then 4.0f + (c.R - c.G) / delta else 0.0f let x = h / 6.0f HslaFloat(x - floor x, s, l, c.A) member c.ShiftHue(shift) = HsvaFloat(c.H + shift, c.S, c.L, c.A) member c.ToRgbaFloat() = // Note: there is a typo in the 2nd International Edition of Foley and // van Dam's "Computer Graphics: Principles and Practice", section 13.3.5 // (The HLS Color Model). This incorrectly replaces the 1f in the following // line with "l", giving confusing results. if c.S = 0.0f then RgbaFloat(c.L, c.L, c.L, c.A) else let m2 = if c.L <= 0.5f then c.L * (1.0f + c.S) else c.L + c.S - c.L * c.S let m1 = 2.0f * c.L - m2 RgbaFloat( HslaFloat.GetChannelValue(m1, m2, (c.H + 1.0f / 3.0f)), HslaFloat.GetChannelValue(m1, m2, c.H), HslaFloat.GetChannelValue(m1, m2, (c.H - 1.0f / 3.0f)), c.A) static member Lerp(min : HslaFloat, max : HslaFloat, t) = HslaFloat( MathF.Lerp(min.H, max.H, t), MathF.Lerp(min.S, max.S, t), MathF.Lerp(min.L, max.L, t), MathF.Lerp(min.A, max.A, t)) static member private GetChannelValue(n1, n2, t) = let hue = if t < 0.0f then t + 1.0f else if t > 1.0f then t - 1.0f else t if hue < 1.0f / 6.0f then n1 + (n2 - n1) * hue * 6.0f else if hue < 0.5f then n2 else if (hue < 2.0f / 3.0f) then n1 + (n2 - n1) * (2.0f / 3.0f - hue) * 6.0f else n1 static member Parse(str : string) = // hsla(120,100%,50%,0.3) let parts = str.Replace(" ", "").Replace("%", "").Split([|','; '('; ')'|], StringSplitOptions.RemoveEmptyEntries) let h = ColorParsing.parse 0.0f parts 1 / 360.0f let s = ColorParsing.parse 0.0f parts 2 / 100.0f let l = ColorParsing.parse 0.0f parts 3 / 100.0f let a = ColorParsing.parse 1.0f parts 4 HslaFloat(h, s, l, a) [] module RgbaByte = type RgbaByte with member c.ToRgbaFloat() = RgbaFloat( float32 c.R / 255.0f, float32 c.G / 255.0f, float32 c.B / 255.0f, float32 c.A / 255.0f) member c.ToUInt32() = (int(c.R) <<< 24) ||| (int(c.G) <<< 16) ||| (int(c.B) <<< 8) ||| (int(c.A) <<< 0) static member FromUInt32(x : uint) = RgbaByte( byte ((x >>> 24) &&& (uint32 0xff)), byte ((x >>> 16) &&& (uint32 0xff)), byte ((x >>> 8) &&& (uint32 0xff)), byte ((x >>> 0) &&& (uint32 0xff))) [] module RgbaFloat = type RgbaFloat with member c.Add(b : RgbaFloat) = RgbaFloat(c.R + b.R, c.G + b.G, c.B + b.B, c.A + b.A) member c.Multiply(b : RgbaFloat) = RgbaFloat(c.R * b.R, c.G * b.G, c.B * b.B, c.A * b.A) member c.Multiply(x) = RgbaFloat(c.R * x, c.G * x, c.B * x, c.A * x) member c.MultiplyRgb(x) = RgbaFloat(c.R * x, c.G * x, c.B * x, c.A) member c.MultiplyAlpha(a) = RgbaFloat(c.R, c.G, c.B, c.A * a) member c.WithAlpha(a) = RgbaFloat(c.R, c.G, c.B, a) member c.Clamp() = RgbaFloat( MathF.Clamp01(c.R), MathF.Clamp01(c.G), MathF.Clamp01(c.B), MathF.Clamp01(c.A)) member c.ToRgbaByte() = RgbaByte( byte (c.R * 255.0f |> max 0.0f |> min 255.0f), byte (c.G * 255.0f |> max 0.0f |> min 255.0f), byte (c.B * 255.0f |> max 0.0f |> min 255.0f), byte (c.A * 255.0f |> max 0.0f |> min 255.0f)) static member Lerp(min : RgbaFloat, max : RgbaFloat, t) = RgbaFloat( MathF.Lerp(min.R, max.R, t), MathF.Lerp(min.G, max.G, t), MathF.Lerp(min.B, max.B, t), MathF.Lerp(min.A, max.A, t)) static member Luminance(x, a) = RgbaFloat(x, x, x, a) static member FromUInt32(x : uint) = RgbaByte.FromUInt32(x).ToRgbaFloat() static member Parse(str : string) = if str.StartsWith("hsla") then HslaFloat.Parse(str).ToRgbaFloat() elif str.StartsWith("hsva") then HsvaFloat.Parse(str).ToRgbaFloat() else // #rrggbbaa match UInt32.TryParse(str.TrimStart([|'#'|]), Globalization.NumberStyles.HexNumber, null) with | true, x -> RgbaFloat.FromUInt32(x) | false, _ -> RgbaFloat.Clear ================================================ FILE: samples/Garnet.Toolkit/Comparisons.fs ================================================ namespace Garnet // The purpose of this is to avoid equality operator allocations for value types. // Be careful if using this with floating point values. // https://github.com/dotnet/fsharp/issues/526 // https://zeckul.wordpress.com/2015/07/09/how-to-avoid-boxing-value-types-in-f-equality-comparisons/ #nowarn "86" module Comparisons = let inline eq<'a when 'a :> System.IEquatable<'a>> (x:'a) (y:'a) = x.Equals y let inline (=) x y = eq x y let inline (<>) x y = not (eq x y) let inline (=@) x y = Microsoft.FSharp.Core.Operators.(=) x y let inline (<>@) x y = Microsoft.FSharp.Core.Operators.(<>) x y let inline lt<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) < 0 let inline gt<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) > 0 let inline lte<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) <= 0 let inline gte<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) >= 0 let inline (<) x y = lt x y let inline (>) x y = gt x y let inline (<=) x y = lte x y let inline (>=) x y = gte x y let inline isNull x = obj.ReferenceEquals(x, null) let inline isNotNull x = not (isNull x) ================================================ FILE: samples/Garnet.Toolkit/Events.fs ================================================ namespace Garnet.Composition open Garnet.Numerics type Start = struct end type Closing = struct end [] type HandleInput = { Time : int64 } [] type Schedule = { DueTime : int64 } [] type Tick = { Time : int64 } [] type Update = { FrameNumber : int64 FixedTime : int64 FixedDeltaTime : int64 Time : int64 DeltaTime : int64 } [] type PreUpdate = { Update : Update } [] type PostUpdate = { Update : Update } [] type FixedUpdate = { FixedFrameNumber : int64 FixedTime : int64 FixedDeltaTime : int64 Time : int64 } [] type Draw = { ViewSize : Vector2i Update : Update } type PushDrawCommands = struct end ================================================ FILE: samples/Garnet.Toolkit/Fonts.fs ================================================ namespace Garnet.Graphics open System open System.Buffers open System.Runtime.CompilerServices open System.Numerics open System.Runtime.InteropServices open Veldrid open Garnet.Numerics open Garnet.Composition /// JSON-serializable type FontCharDescriptor = { Code : char Width : int OffsetX : int OffsetY : int RectX : int RectY : int RectWidth : int RectHeight : int } /// JSON-serializable type FontDescriptor = { Size : int Family : string Style : string Height : int Chars : FontCharDescriptor[] } type Align = | Left = 0 | Center = 1 | Right = 2 type Valign = | Top = 0 | Center = 1 | Bottom = 2 type TextWrapping = | NoWrap = 0 | WordWrap = 1 [] type TextBlock = { Text : string Color : RgbaFloat Bounds : Range2i Scale : int Align : Align Valign : Valign Wrapping : TextWrapping Spacing : Vector2i } with static member Default = { Text = "" Color = RgbaFloat.White Bounds = Range2i.Zero Scale = 1 Align = Align.Left Valign = Valign.Top Wrapping = TextWrapping.NoWrap Spacing = Vector2i.Zero } [] type FontCharInfo = { Width : int Offset : Vector2i Size : Vector2i Rect : Range2 } module private FontRun = let getCharWidth ch (charWidths : int[]) = let index = int ch if index < charWidths.Length then charWidths.[index] else 0 let getTrimmedRange (str : string) (run : Rangei) = let mutable start = run.Min while start < run.Max && Char.IsWhiteSpace str.[start] do start <- start + 1 let mutable stop = run.Max while stop > run.Min && Char.IsWhiteSpace str.[stop - 1] do stop <- stop - 1 Rangei(start, stop) let isWhitespace ch = Char.IsWhiteSpace ch || ch = '\n' let getWordStart (str : string) start = let mutable i = start while i < str.Length && isWhitespace str.[i] do i <- i + 1 i let getWordEnd (str : string) start = let mutable i = start while i < str.Length && not (isWhitespace str.[i]) do i <- i + 1 i let getRunWidth (str : string) (charWidths : int[]) (run : Rangei) = let mutable width = 0 for i = run.Min to run.Max - 1 do width <- width + getCharWidth str.[i] charWidths width let tryGetNextRun (str : string) charWidths start maxAllowedWidth = let mutable runWidth = 0 let mutable i = start let mutable result = ValueNone while result.IsNone && i < str.Length do let ch = str.[i] if ch = '\n' then // Newline result <- ValueSome (Rangei(start, i + 1)) else runWidth <- runWidth + getCharWidth str.[i] charWidths if runWidth > maxAllowedWidth then // Backtrack to start of word let mutable stop = i while stop > start + 1 && not (Char.IsWhiteSpace(str.[stop])) do stop <- stop - 1 result <- ValueSome (Rangei(start, stop + 1)) i <- i + 1 // If no newline or limit reached, return remainder if result.IsNone then let remaining = str.Length - start if remaining > 0 then result <- ValueSome (Rangei(start, str.Length)) result let measure (str : string) (charWidths : int[]) charHeight maxAllowedWidth = let mutable maxWidth = 0 let mutable count = 0 let mutable runOpt = tryGetNextRun str charWidths 0 maxAllowedWidth while runOpt.IsSome do let run = runOpt.Value let width = getRunWidth str charWidths run maxWidth <- max maxWidth width count <- count + 1 runOpt <- tryGetNextRun str charWidths run.Max maxAllowedWidth Vector2i(maxWidth, count * charHeight) let getBounds (size : Vector2i) (bounds : Range2i) align valign = let p0 = bounds.Min let p1 = bounds.Max let boxSize = p1 - p0 let x0 = match align with | Align.Left -> p0.X | Align.Right -> p1.X - size.X | Align.Center -> p0.X + (boxSize.X - size.X) / 2 | x -> failwith $"Invalid align {x}" let y0 = match valign with | Valign.Top -> p0.Y | Valign.Bottom -> p1.Y - size.Y | Valign.Center -> p0.Y + (boxSize.Y - size.Y) / 2 | x -> failwith $"Invalid valign {x}" Range2i.Sized(Vector2i(x0, y0), size) let getMaxAllowedWidth wrapping size = match wrapping with | TextWrapping.NoWrap -> Int32.MaxValue | TextWrapping.WordWrap -> size | x -> failwith $"Invalid wrapping {x}" module private FontCharInfo = let getTexBounds (charRect : Range2i) (mapSize : Vector2i) texBounds = let scale = Vector2.One / (mapSize.ToVector2()) let t0 = charRect.Min.ToVector2() * scale let t1 = charRect.Max.ToVector2() * scale let p0 = Range2.Lerp(texBounds, t0) let p1 = Range2.Lerp(texBounds, t1) Range2(p0, p1) let fromCharDescriptor (mapSize : Vector2i) (p : FontCharDescriptor) (texBounds : Range2) = let r = Range2i.Sized(Vector2i(p.RectX, p.RectY), Vector2i(p.RectWidth, p.RectHeight)) { Width = p.Width Offset = Vector2i(p.OffsetX, p.OffsetY) Size = Vector2i(p.RectWidth, p.RectHeight) Rect = getTexBounds r mapSize texBounds } type Font(height, charLookup : FontCharInfo[]) = let widths = charLookup |> Array.map (fun c -> c.Width) member c.Height = height member c.GetCharInfo(ch : char) = let code = int ch if code < charLookup.Length then charLookup.[code] else charLookup.[0] member c.TryGetNextRun(str, start, maxAllowedWidth) = FontRun.tryGetNextRun str widths start maxAllowedWidth member c.Measure(text) = FontRun.measure text widths height Int32.MaxValue member c.Measure(block) = let bounds = block.Bounds let maxAllowedWidth = FontRun.getMaxAllowedWidth block.Wrapping (bounds.Size.X * block.Scale) let size = FontRun.measure block.Text widths height maxAllowedWidth * block.Scale FontRun.getBounds size bounds block.Align block.Valign static member CreateMonospaced(charSheetSize : Vector2i, texBounds, xSpacing) = // Assume this is a 16x16 char tile sheet let charSize = charSheetSize / 16 let lookup = [| for y = 0 to 15 do for x = 0 to 15 do let p = Vector2i(x, y) * charSize let charRect = Range2i.Sized(p, charSize) { Width = charSize.X + xSpacing Offset = Vector2i.Zero Size = charSize Rect = FontCharInfo.getTexBounds charRect charSheetSize texBounds } |] Font(charSize.Y, lookup) static member FromDescriptor(desc, mapSize, texBounds) = let table = Array.zeroCreate 256 for ch in desc.Chars do let code = int ch.Code if code < table.Length then let coords = FontCharInfo.fromCharDescriptor mapSize ch texBounds table.[code] <- coords Font(desc.Height, table) [] module FontLoadingExtensions = type IReadOnlyFolder with member c.LoadJsonFontDescriptor(fontName : string) = c.LoadJson(fontName) type IResourceCache with /// Loads a monospace font stored in a texture atlas member c.LoadMonospacedFont(atlasName, fontName, xSpacing) = match c.TryGetResource(fontName) with | true, font -> font | false, _ -> let atlas = c.LoadResource(atlasName) let tex = atlas.[fontName] let font = Font.CreateMonospaced(tex.Bounds.Size, tex.NormalizedBounds, xSpacing) c.AddResource(fontName, font) font /// Loads a JSON font paired with a PNG with matching name member c.LoadJsonFont(fontName, fontTextureName, [] atlasName : string) = match c.TryGetResource(fontName) with | true, font -> font | false, _ -> let desc = c.LoadResource(fontName) let font = if String.IsNullOrEmpty(atlasName) then let tex = c.LoadResource(fontTextureName) Font.FromDescriptor(desc, Vector2i(int tex.Width, int tex.Height), Range2.ZeroToOne) else let atlas = c.LoadResource(atlasName) let tex = atlas.[fontTextureName] let size = tex.Bounds.Size //- Vector2i.One * tex.Padding * 2 let texBounds = tex.NormalizedBounds Font.FromDescriptor(desc, Vector2i(abs size.X, abs size.Y), texBounds) c.AddResource(fontName, font) font type FontLoader() = interface IResourceLoader with member c.Load(folder, cache, key) = let font = folder.LoadJsonFontDescriptor(key) cache.AddResource(key, font) [] module FontLoaderExtensions = type ResourceCache with member c.AddFontLoaders() = c.AddLoader(".font.json", FontLoader()) [] type FontVertexSpanExtensions = /// Draws monospace text [] static member DrawText(w : IBufferWriter, text : string, pos : Vector2i, atlasSize : Vector2i, fontTexBounds : Range2i, charMargin : Vector2i, color : RgbaFloat) = let charSetSize = fontTexBounds.Size let charSize = charSetSize / Vector2i(16, 16) let displayCharSize = charSize + charMargin let atlasScale = Vector2.One / atlasSize.ToVector2() let span = w.GetQuadSpan(text.Length) for i = 0 to text.Length - 1 do let ch = text.[i] let tileId = int ch let tx = tileId &&& 0xf let ty = tileId >>> 4 let t0 = Vector2i(tx, ty) * charSize + fontTexBounds.Min let t1 = t0 + charSize let tb = Range2(t0.ToVector2() * atlasScale, t1.ToVector2() * atlasScale) let b = Range2i.Sized(pos + Vector2i(i * displayCharSize.X, 0), charSize) let span = span.Slice(i * 4) span.DrawQuad(b.ToRange2(), tb, color) w.Advance(span.Length) [] static member DrawText(w : IBufferWriter, font : Font, block : TextBlock) = let textBounds = font.Measure(block) let span = w.GetQuadSpan(block.Text.Length) let maxUnscaledWidth = match block.Wrapping with | TextWrapping.NoWrap -> Int32.MaxValue | TextWrapping.WordWrap -> block.Bounds.Size.X / block.Scale | x -> failwith $"Invalid wrapping: {x}" let mutable runOpt = font.TryGetNextRun(block.Text, 0, maxUnscaledWidth) let mutable row = 0 let mutable vi = 0 while runOpt.IsSome do let run = runOpt.Value let y = textBounds.Y.Min + row * font.Height * block.Scale let mutable x = textBounds.X.Min for i = run.Min to run.Max - 1 do let ch = block.Text.[i] let desc = font.GetCharInfo(ch) if desc.Size.X > 0 then let b = let offset = desc.Offset * block.Scale let p0 = Vector2i(x + offset.X, y + offset.Y) let p1 = p0 + desc.Size * block.Scale Range2i(p0, p1) let span = span.Slice(vi) span.DrawQuad(b.ToRange2(), desc.Rect, block.Color) vi <- vi + 4 x <- x + desc.Width * block.Scale runOpt <- font.TryGetNextRun(block.Text, run.Max, maxUnscaledWidth) row <- row + 1 w.Advance(vi) [] static member DrawText(w : IBufferWriter, font, text, pos : Vector2i, color : RgbaFloat, [] width : int, [] height : int, [] align : Align, [] valign : Valign, [] wrapping : TextWrapping, [] scale : int, [] xSpacing : int, [] ySpacing : int ) = w.DrawText(font, { Text = text Color = color Bounds = Range2i.Sized(pos, Vector2i(width, height)) Scale = scale Align = align Valign = valign Wrapping = wrapping Spacing = Vector2i(xSpacing, ySpacing) }) ================================================ FILE: samples/Garnet.Toolkit/Garnet.Toolkit.fsproj ================================================  net6.0 false Garnet.Toolkit Utility code for games, including graphics, audio, and integration with Garnet. graphics audio game PreserveNewest runtimes/win-x64/native true PreserveNewest runtimes/win-x86/native true ================================================ FILE: samples/Garnet.Toolkit/Input.fs ================================================ namespace Garnet.Input open System open System.Collections.Generic open System.Numerics open Veldrid open Garnet.Numerics [] type KeyDown = { KeyCode : Key Modifiers : ModifierKeys } with static member None = { KeyCode = Key.Unknown Modifiers = ModifierKeys.None } [] type KeyUp = { KeyCode : Key Modifiers : ModifierKeys } [] type MouseWheel = { modifiers : int wheel : int } [] type MouseUpdate = { pos : Vector2 devicePos : Vector2i button1 : bool button2 : bool } [] type MouseMoved = { pos : Vector2 delta : Vector2 devicePos : Vector2i deviceDelta : Vector2i modifiers : ModifierKeys } [] type MouseDown = { pos : Vector2 devicePos : Vector2i button : int modifiers : ModifierKeys } [] type MouseUp = { pos : Vector2 devicePos : Vector2i button : int } [] module InputExtensions = type ModifierKeys with member c.IsShift() = int c = int ModifierKeys.Shift member c.IsCtrl() = int c = int ModifierKeys.Control member c.IsAlt() = int c = int ModifierKeys.Alt member c.HasShift() = int (c &&& ModifierKeys.Shift) <> 0 member c.HasCtrl() = int (c &&& ModifierKeys.Control) <> 0 member c.HasAlt() = int (c &&& ModifierKeys.Alt) <> 0 type InputCollection() = let keys = Array.zeroCreate (int Key.LastKey) let keyUpEvents = List() let keyDownEvents = List() let mouseDownEvents = List() let mouseUpEvents = List() let mouseButtons = Array.zeroCreate 10 let mutable mousePos = Vector2i.Zero let mutable lastMousePos = Vector2i.Zero let mutable normMousePos = Vector2.Zero let mutable lastNormMousePos = Vector2.Zero let mutable wheelDelta = 0.0f member c.MousePosition = mousePos member c.LastMousePosition = lastMousePos member c.MouseDelta = mousePos - lastMousePos member c.NormalizedMousePosition = normMousePos member c.LastNormalizedMousePosition = lastNormMousePos member c.NormalizedMouseDelta = normMousePos - lastNormMousePos member c.WheelDelta = wheelDelta member c.KeyUpEvents = keyUpEvents member c.KeyDownEvents = keyDownEvents member c.MouseUpEvents = mouseUpEvents member c.MouseDownEvents = mouseDownEvents member c.Modifiers = let hasAlt = c.IsKeyDown(Key.AltLeft) || c.IsKeyDown(Key.AltRight) || c.IsKeyDown(Key.LAlt) || c.IsKeyDown(Key.RAlt) let hasCtrl = c.IsKeyDown(Key.ControlLeft) || c.IsKeyDown(Key.ControlRight) || c.IsKeyDown(Key.LControl) || c.IsKeyDown(Key.RControl) let hasShift = c.IsKeyDown(Key.ShiftLeft) || c.IsKeyDown(Key.ShiftRight) || c.IsKeyDown(Key.LShift) || c.IsKeyDown(Key.RShift) (if hasAlt then ModifierKeys.Alt else ModifierKeys.None) ||| (if hasCtrl then ModifierKeys.Control else ModifierKeys.None) ||| (if hasShift then ModifierKeys.Shift else ModifierKeys.None) member c.IsMouseDown(button) = mouseButtons.[button] member c.IsMousePressed(button) = mouseDownEvents.Contains(button) member c.IsKeyDown(code : Key) = keys.[int code] member c.IsKeyPressed(code, modifiers) = keyDownEvents.Contains { KeyCode = code Modifiers = modifiers } member c.UpdateMouse(newPos, newNormPos, newWheelDelta) = wheelDelta <- newWheelDelta lastMousePos <- mousePos mousePos <- newPos lastNormMousePos <- normMousePos normMousePos <- newNormPos member c.SetMouseButton(button : MouseButton, state) = if mouseButtons.[int button] <> state then if state then mouseDownEvents.Add(int button) else mouseUpEvents.Add(int button) mouseButtons.[int button] <- state member c.Add(code, modifier) = keys.[int code] <- true keyDownEvents.Add { KeyCode = code Modifiers = modifier } member c.Remove(code, modifier) = keys.[int code] <- false keyUpEvents.Add { KeyCode = code Modifiers = modifier } member c.Clear() = Array.Clear(keys, 0, keys.Length) member c.ClearEvents() = keyUpEvents.Clear() keyDownEvents.Clear() mouseDownEvents.Clear() mouseUpEvents.Clear() override c.ToString() = String.Join(", ", keys) type InputCollection with member c.IsKeyDown(code, modifier : ModifierKeys) = c.IsKeyDown(code) && int modifier = int c.Modifiers member c.IsKeyPressed(code) = c.IsKeyPressed(code, ModifierKeys.None) member c.IsAnyKeyDown(codes : IReadOnlyList) = let mutable down = false for i = 0 to codes.Count - 1 do let code = codes.[i] down <- down || c.IsKeyDown(code) down member c.IsAnyKeyPressed(codes : IReadOnlyList, modifiers) = let mutable down = false for i = 0 to codes.Count - 1 do let code = codes.[i] down <- down || c.IsKeyPressed(code, modifiers) down member c.IsAnyKeyPressed(codes) = c.IsAnyKeyPressed(codes, ModifierKeys.None) member c.UpdateKeysFromSnapshot(snapshot : InputSnapshot) = for i = 0 to snapshot.KeyEvents.Count - 1 do let e = snapshot.KeyEvents.[i] let m = e.Modifiers let key = e.Key if e.Down then c.Add(key, m) else c.Remove(key, e.Modifiers) member c.UpdateMouseFromSnapshot(snapshot : InputSnapshot, viewSize : Vector2i) = let mousePos = Vector2i(int snapshot.MousePosition.X, int snapshot.MousePosition.Y) let normMousePosition = let v = snapshot.MousePosition / viewSize.ToVector2() * 2.0f - Vector2.One Vector2(v.X, -v.Y) c.UpdateMouse(mousePos, normMousePosition, snapshot.WheelDelta) for e in snapshot.MouseEvents do let button = e.MouseButton c.SetMouseButton(button, e.Down) ================================================ FILE: samples/Garnet.Toolkit/Logging.fs ================================================ namespace Garnet.Composition open System open System.IO open Microsoft.Extensions.Logging open Cysharp.Text open ZLogger type LogSettings = { WriteToFile : bool WriteToConsole : bool RollFile : bool LogPath : string LogName : string TimestampFormat : string PrefixFormat : string MinLogLevel : LogLevel FileRollSizeKb : int } module private Logging = let configure settings (options : ZLoggerOptions) = let prefixFormat = ZString.PrepareUtf8(settings.PrefixFormat) options.PrefixFormatter <- fun writer info -> let mutable w = writer let timestamp = info.Timestamp.DateTime.ToLocalTime().ToString(settings.TimestampFormat) prefixFormat.FormatTo(&w, timestamp, info.LogLevel, info.CategoryName) type LogSettings with static member Default = { WriteToFile = true WriteToConsole = false RollFile = false LogPath = "." LogName = "run" TimestampFormat = "yyyy-MM-dd HH:mm:ss.fff" PrefixFormat = "{0} {1} [{2}] " MinLogLevel = LogLevel.Information FileRollSizeKb = 1024 } member settings.CreateFactory() = LoggerFactory.Create(fun builder -> let builder = builder.SetMinimumLevel(settings.MinLogLevel) // Add console let builder = if settings.WriteToConsole then builder.AddZLoggerConsole(Logging.configure settings) else builder // Add rolling file let _ = if settings.WriteToFile then if settings.RollFile then let logPrefix = Path.Combine(settings.LogPath, settings.LogName + "-") builder.AddZLoggerRollingFile( (fun dt index -> let timestamp = dt.ToLocalTime().ToString("yyyy-MM-dd") let num = index.ToString().PadLeft(3, '0') $"{logPrefix}{timestamp}_{num}.log"), (fun dt -> DateTimeOffset(dt.ToLocalTime().Date)), settings.FileRollSizeKb, Action(Logging.configure settings)) else let file = Path.Combine(settings.LogPath, settings.LogName + ".log") builder.AddZLoggerFile(file, Action<_>(Logging.configure settings)) else builder ()) [] module LoggingExtensions = type Container with static member RunLoop(settings : LogSettings, register) = use factory = settings.CreateFactory() let logger = factory.CreateLogger("Default") try let c = Container() c.Set(logger) use s = register c c.RunLoop() with ex -> logger.LogError(ex, "") static member RunLoop(register) = Container.RunLoop(LogSettings.Default, register) ================================================ FILE: samples/Garnet.Toolkit/Looping.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.Diagnostics open System.Runtime.CompilerServices open System.Threading open System.Runtime.InteropServices open Garnet.Composition [] type Looping = [] static member RunLoop(c : Container, [] sleepDuration) = let mutable running = true use sub = c.On <| fun _ -> running <- false c.Run(Start()) let sw = Stopwatch.StartNew() while running do c.Run { Time = sw.ElapsedMilliseconds } // Sleep to avoid spinning CPU if sleepDuration >= 0 then Thread.Sleep(sleepDuration) [] static member RunStartup(c : ActorSystem, loopActorId : ActorId, destIds : ActorId seq) = // Create error handler to collect exceptions let exceptions = List() use sub = c.RegisterExceptionHandler(fun ex -> exceptions.Add(ex)) // Send start message to all root actors let destIds = ReadOnlySpan(destIds |> Seq.toArray) for destId in destIds do c.Send(destId, loopActorId, Start()) // Wait for all threads to complete c.ProcessAll() if exceptions.Count > 0 then raise (AggregateException("Startup failed", exceptions)) [] static member RunLoop(c : ActorSystem, loopActorId : ActorId, destActorId : ActorId, [] sleepDuration) = let exceptions = List() let mutable running = true // Stop on exception use sub = c.RegisterExceptionHandler(fun ex -> exceptions.Add(ex) running <- false) // Stop if closing message received c.Register(loopActorId, fun (c : Container) -> c.On <| fun _ -> running <- false) // Run loop let sw = Stopwatch.StartNew() while running do // Send tick to destination actor with source as loop actor to indicate // where closing messages should be sent. let e = { Time = sw.ElapsedMilliseconds } c.Send(destActorId, loopActorId, e) c.Process() // Sleep to avoid spinning CPU if sleepDuration >= 0 then Thread.Sleep(sleepDuration) // Wait for all threads to complete c.ProcessAll() if exceptions.Count > 0 then raise (AggregateException("Updating failed", exceptions)) ================================================ FILE: samples/Garnet.Toolkit/Meshes.fs ================================================ namespace Garnet.Graphics open System open System.Buffers open Veldrid open Garnet.Collections type ResizableDeviceBuffer(device : GraphicsDevice, elementSize, usage) = let mutable buffer = device.ResourceFactory.CreateBuffer(BufferDescription(uint32 (elementSize * 8), usage)) member c.Buffer = buffer member c.Write<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType>(src : ReadOnlyMemory<'v>) = // ensure device buffer is large enough let size = src.Length * elementSize if buffer.SizeInBytes < uint32 size then // destroy old buffer buffer.Dispose() // round up to pow2 number of elements (not bytes) let requiredSize = Buffer.getRequiredCount src.Length * elementSize let desc = BufferDescription(uint32 requiredSize, usage) buffer <- device.ResourceFactory.CreateBuffer(desc) // write data use handle = src.Pin() device.UpdateBuffer(buffer, 0u, IntPtr handle.Pointer, uint32 size) member c.Dispose() = buffer.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type DeviceMesh(device, vertexSize) = let vb = new ResizableDeviceBuffer(device, vertexSize, BufferUsage.Dynamic ||| BufferUsage.VertexBuffer) let ib = new ResizableDeviceBuffer(device, sizeof, BufferUsage.Dynamic ||| BufferUsage.IndexBuffer) member c.WriteVertices(src) = vb.Write(src) member c.WriteIndexes(src) = ib.Write(src) member c.Draw(cmds : CommandList, indexCount) = if indexCount > 0 then cmds.SetVertexBuffer(0u, vb.Buffer) cmds.SetIndexBuffer(ib.Buffer, IndexFormat.UInt32) cmds.DrawIndexed( indexCount = uint32 indexCount, instanceCount = 1u, indexStart = 0u, vertexOffset = 0, instanceStart = 0u) member c.Dispose() = vb.Dispose() ib.Dispose() type QuadIndexBuffer(device : GraphicsDevice) = let indexesPer = 6 let verticesPer = 4 let elementSize = sizeof let usage = BufferUsage.Dynamic ||| BufferUsage.IndexBuffer // Initially allocate just 1 to force creation on first request let mutable buffer = device.ResourceFactory.CreateBuffer(BufferDescription(1u, usage)) member private c.Update(requestedCount) = let bytesPer = elementSize * indexesPer let bufferedCount = int buffer.SizeInBytes / bytesPer if bufferedCount < requestedCount then // Round up to pow2 number of elements (not bytes) let requiredCount = Buffer.getRequiredCount requestedCount let requiredIndexes = requiredCount * indexesPer let requiredBytes = requiredCount * bytesPer // Generate indexes for primitive let arr = ArrayPool.Shared.Rent(requiredIndexes) for i = 0 to requiredCount - 1 do let vi = i * verticesPer let ii = i * indexesPer arr.[ii + 0] <- vi + 0 arr.[ii + 1] <- vi + 1 arr.[ii + 2] <- vi + 2 arr.[ii + 3] <- vi + 0 arr.[ii + 4] <- vi + 2 arr.[ii + 5] <- vi + 3 // Destroy old device buffer and create new one buffer.Dispose() let desc = BufferDescription(uint32 requiredBytes, usage) buffer <- device.ResourceFactory.CreateBuffer(desc) // Write data to device buffer let src = ReadOnlyMemory(arr) use handle = src.Pin() device.UpdateBuffer(buffer, 0u, IntPtr handle.Pointer, uint32 requiredBytes) ArrayPool.Shared.Return(arr) member c.Draw(cmds : CommandList, primitiveCount) = if primitiveCount > 0 then c.Update(primitiveCount) cmds.SetIndexBuffer(buffer, IndexFormat.UInt32) cmds.DrawIndexed( indexCount = uint32 (primitiveCount * indexesPer), instanceCount = 1u, indexStart = 0u, vertexOffset = 0, instanceStart = 0u) member c.Dispose() = buffer.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type IVertexBuffer = inherit IDisposable abstract VertexCount : int abstract SetVertexBuffer : CommandList -> unit abstract Flush : unit -> unit type VertexBuffer<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType>(device) = let vertices = ArrayBufferWriter<'v>() let vb = new ResizableDeviceBuffer(device, sizeof<'v>, BufferUsage.Dynamic ||| BufferUsage.VertexBuffer) let mutable vertexCount = 0 member c.VertexCount = vertexCount member c.WrittenSpan = vertices.WrittenSpan member c.GetMemory(count) = vertices.GetMemory(count) member c.GetSpan(count) = vertices.GetSpan(count) member c.Advance(count) = vertices.Advance(count) member c.Flush() = vertexCount <- vertices.WrittenCount vb.Write(vertices.WrittenMemory) vertices.Clear() interface IBufferWriter<'v> with member c.GetSpan(count) = c.GetSpan(count) member c.GetMemory(count) = c.GetMemory(count) member c.Advance(count) = c.Advance(count) member c.SetVertexBuffer(commands : CommandList) = commands.SetVertexBuffer(0u, vb.Buffer) member c.Dispose() = vb.Dispose() interface IVertexBuffer with member c.VertexCount = vertexCount member c.SetVertexBuffer(commands) = c.SetVertexBuffer(commands) member c.Flush() = c.Flush() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Toolkit/Offscreen.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.Numerics open Veldrid type PositionTextureColorQuadMesh(device : GraphicsDevice) = let vb = let size = uint32 (sizeof * 4) let b = device.ResourceFactory.CreateBuffer(BufferDescription(size, BufferUsage.VertexBuffer)) device.UpdateBuffer(b, 0u, [| // flip Y tex coords { Position = Vector3(-1.0f, -1.0f, 0.0f); TexCoord = Vector2(0.0f, 1.0f); Color = RgbaFloat.White } { Position = Vector3(+1.0f, -1.0f, 0.0f); TexCoord = Vector2(1.0f, 1.0f); Color = RgbaFloat.White } { Position = Vector3(+1.0f, +1.0f, 0.0f); TexCoord = Vector2(1.0f, 0.0f); Color = RgbaFloat.White } { Position = Vector3(-1.0f, +1.0f, 0.0f); TexCoord = Vector2(0.0f, 0.0f); Color = RgbaFloat.White } |]) b let ib = let b = device.ResourceFactory.CreateBuffer(BufferDescription(uint32 (sizeof * 6), BufferUsage.IndexBuffer)) device.UpdateBuffer(b, 0u, [| 0u; 1u; 2u; 0u; 2u; 3u |]) b member c.Draw(cmds : CommandList) = cmds.SetVertexBuffer(0u, vb) cmds.SetIndexBuffer(ib, IndexFormat.UInt32) cmds.DrawIndexed( indexCount = 6u, instanceCount = 1u, indexStart = 0u, vertexOffset = 0, instanceStart = 0u) member c.Dispose() = vb.Dispose() ib.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type ColorDepthRenderTarget(device : GraphicsDevice, width, height) = let renderTarget = device.ResourceFactory.CreateTexture( TextureDescription( uint32 width, uint32 height, 1u, 1u, 1u, PixelFormat.R16_G16_B16_A16_Float, TextureUsage.RenderTarget ||| TextureUsage.Sampled, TextureType.Texture2D)) let depthTexture = device.ResourceFactory.CreateTexture( TextureDescription.Texture2D( uint32 width, uint32 height, 1u, 1u, PixelFormat.R32_Float, TextureUsage.DepthStencil)) let frameBuffer = device.ResourceFactory.CreateFramebuffer( FramebufferDescription(depthTexture, renderTarget)) member c.Texture = renderTarget member c.OutputDescription = frameBuffer.OutputDescription member c.SetFramebuffer(cmds : CommandList) = cmds.SetFramebuffer(frameBuffer) member c.Dispose() = renderTarget.Dispose() depthTexture.Dispose() frameBuffer.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type ColorRenderTargetBuffer(device : GraphicsDevice, width, height) = let renderTarget = device.ResourceFactory.CreateTexture( TextureDescription( uint32 width, uint32 height, 1u, 1u, 1u, PixelFormat.R16_G16_B16_A16_Float, TextureUsage.RenderTarget ||| TextureUsage.Sampled, TextureType.Texture2D)) let frameBuffer = device.ResourceFactory.CreateFramebuffer( FramebufferDescription(null, renderTarget)) member c.Texture = renderTarget member c.OutputDescription = frameBuffer.OutputDescription member c.PushFramebuffer(context : RenderContext) = context.PushFramebuffer(frameBuffer) member c.Dispose() = renderTarget.Dispose() frameBuffer.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type ColorRenderTargetPipeline(device : GraphicsDevice, width, height, shaders, sampler, blend) = let target = new ColorRenderTargetBuffer(device, width, height) let pipelines = Dictionary<_, TextureTrianglePipeline>() member c.Width = width member c.Height = height member c.PushFramebuffer(context) = target.PushFramebuffer(context) member c.SetPipeline(cmds : CommandList, worldTransform, outputDesc) = let pipeline = match pipelines.TryGetValue(outputDesc) with | true, x -> x | false, _ -> let pipeline = new TextureTrianglePipeline(device, shaders, target.Texture, sampler, blend, outputDesc) pipelines.Add(outputDesc, pipeline) pipeline pipeline.SetPipeline(cmds) pipeline.SetProjectionView(Matrix4x4.Identity, Matrix4x4.Identity, cmds) pipeline.SetWorldTexture(worldTransform, Matrix4x4.Identity, cmds) member c.Dispose() = target.Dispose() for pipeline in pipelines.Values do pipeline.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() /// Offscreen render target along with a quad mesh so render target can be drawn in /// another viewport. Does not take ownership of shaders or drawables. type RenderTarget(device : GraphicsDevice, shaders, filtering, blend) = let sampler = device.GetSampler(filtering) let mesh = new PositionTextureColorQuadMesh(device) let mutable pipelineOpt = ValueNone member val Background = RgbaFloat.Black with get, set member val WorldTransform = Matrix4x4.Identity with get, set member val Width = 0 with get, set member val Height = 0 with get, set member private c.CreatePipeline() = let pipeline = new ColorRenderTargetPipeline(device, c.Width, c.Height, shaders, sampler, blend) pipelineOpt <- ValueSome pipeline pipeline member c.BeginDraw(context) = let pipeline = match pipelineOpt with | ValueNone -> c.CreatePipeline() | ValueSome pipeline -> if pipeline.Width = c.Width && pipeline.Height = c.Height then pipeline else pipeline.Dispose() c.CreatePipeline() // Set target before making draw calls for render target pipeline.PushFramebuffer(context) context.Commands.ClearColorTarget(0u, c.Background) member c.EndDraw(context : RenderContext) = match pipelineOpt with | ValueNone -> () | ValueSome pipeline -> // Draw render target itself as a quad context.PopFramebuffer() pipeline.SetPipeline(context.Commands, c.WorldTransform, context.OutputDescription) mesh.Draw(context.Commands) member c.Dispose() = match pipelineOpt with | ValueNone -> () | ValueSome pipeline -> pipeline.Dispose() mesh.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Toolkit/Particles.fs ================================================ namespace Garnet.Graphics open System.Collections.Generic open System.Numerics open Veldrid open Garnet.Numerics open Garnet.Collections type ParticleAnimation = { RandomSeed : uint64 AnimationId : int Layer : SpriteLayerDescriptor Duration : float32 Width : float32 Height : float32 SizeByEnergy : float32 OpacityByEnergy : float32 Textures : string[] MinTint : RgbaFloat MaxTint : RgbaFloat TintWeight : float32 MinHue : float32 MaxHue : float32 MinSaturation : float32 MaxSaturation : float32 MinValue : float32 MaxValue : float32 Opacity : float32 UseColor : bool StartColor : RgbaFloat EndColor : RgbaFloat MinSpeed : float32 MaxSpeed : float32 VelocityAngleRange : float32 RotationAngleRange : float32 MinCount : int MaxCount : int InitialDistance : float32 InitialSize : float32 InitialSizeRange : float32 } [] type ParticleEmission = { GroupId : int EmitDelay : float32 EmitInterval : float32 EmitCount : int Position : Vector2 Velocity : Vector2 Rotation : Vector2 Color : RgbaFloat Energy : float32 } type ParticleGroup = { GroupId : int Animations : ParticleAnimation[] } type ParticleAnimation with static member Defaults = { RandomSeed = 1UL AnimationId = 0 Layer = Unchecked.defaultof<_> Duration = 1.0f Width = 1.0f Height = 1.0f SizeByEnergy = 0.0f OpacityByEnergy = -1.0f Textures = Array.empty MinHue = 0.0f MaxHue = 0.0f MinSaturation = 0.0f MaxSaturation = 0.0f MinValue = 1.0f MaxValue = 1.0f MinTint = RgbaFloat.White MaxTint = RgbaFloat.White UseColor = false StartColor = RgbaFloat.White EndColor = RgbaFloat.White MinSpeed = 0.0f MaxSpeed = 0.0f VelocityAngleRange = 360.0f RotationAngleRange = 360.0f MinCount = 1 MaxCount = 1 InitialDistance = 0.0f InitialSize = 1.0f InitialSizeRange = 0.0f TintWeight = 1.0f Opacity = 1.0f } type private ParticleBuffers() = [] val mutable timestamps : int64[] [] val mutable positions : Vector2[] [] val mutable velocities : Vector2[] [] val mutable sizes : float32[] [] val mutable rotations : Vector2[] [] val mutable energies : float32[] [] val mutable colors : RgbaFloat[] [] val mutable opacities : float32[] [] val mutable texIndices : int[] member c.Allocate(count) = Buffer.resizeArray count &c.timestamps Buffer.resizeArray count &c.positions Buffer.resizeArray count &c.velocities Buffer.resizeArray count &c.sizes Buffer.resizeArray count &c.rotations Buffer.resizeArray count &c.energies Buffer.resizeArray count &c.colors Buffer.resizeArray count &c.opacities Buffer.resizeArray count &c.texIndices static member inline Copy(src : ParticleBuffers, srcIndex, dest : ParticleBuffers, destIndex) = dest.timestamps.[destIndex] <- src.timestamps.[srcIndex] dest.positions.[destIndex] <- src.positions.[srcIndex] dest.velocities.[destIndex] <- src.velocities.[srcIndex] dest.sizes.[destIndex] <- src.sizes.[srcIndex] dest.rotations.[destIndex] <- src.rotations.[srcIndex] dest.energies.[destIndex] <- src.energies.[srcIndex] dest.colors.[destIndex] <- src.colors.[srcIndex] dest.opacities.[destIndex] <- src.opacities.[srcIndex] dest.texIndices.[destIndex] <- src.texIndices.[srcIndex] /// Cached for every kind of animation, not per emission type ParticleSet(anim : ParticleAnimation) = let rand = PcgRandom(anim.RandomSeed, 1UL) let texBounds = Array.zeroCreate anim.Textures.Length let b = ParticleBuffers() let mutable time = 0L let mutable pc = 0 let swapRemove (index : int byref) = pc <- pc - 1 ParticleBuffers.Copy(b, pc, b, index) index <- index - 1 let pruneByTimestamp() = let mutable i = 0 while i < pc do if time < b.timestamps.[i] then swapRemove &i i <- i + 1 let updateEnergy energyUnitToTick = let energyRate = -energyUnitToTick let mutable i = 0 while i < pc do let e = b.energies.[i] + energyRate if e > 0.0f then b.energies.[i] <- e else swapRemove &i i <- i + 1 let addToScalars (arr : _[]) pc delta = if abs delta > 0.0f then for i = 0 to pc - 1 do arr.[i] <- arr.[i] + delta let updatePositions deltaTime = for i = 0 to pc - 1 do b.positions.[i] <- b.positions.[i] + b.velocities.[i] * deltaTime let updateColors () = if anim.UseColor then let c0 = anim.StartColor let c1 = anim.EndColor for i = 0 to pc - 1 do b.colors.[i] <- RgbaFloat.Lerp(c0, c1, b.energies.[i]) member c.ParticleCount = pc member c.Clear() = pc <- 0 time <- 0L member s.Update(deltaTime : int64) = time <- time + deltaTime if pc > 0 then pruneByTimestamp() // Energy goes from 1.0 to 0.0 over duration let deltaSec = float32 deltaTime / 1000.0f let relativeDelta = deltaSec / anim.Duration let opacityDelta = anim.OpacityByEnergy * relativeDelta let sizeDelta = anim.SizeByEnergy * relativeDelta updateEnergy relativeDelta addToScalars b.opacities pc opacityDelta addToScalars b.sizes pc sizeDelta updatePositions deltaSec updateColors () member s.Emit(pe : ParticleEmission) = let emitCount = let x0 = anim.MinCount * pe.EmitCount let x1 = anim.MaxCount * pe.EmitCount rand.NextInt32(x0, x1) let size = let x0 = anim.InitialSize - anim.InitialSizeRange * 0.5f let x1 = anim.InitialSize + anim.InitialSizeRange * 0.5f rand.NextSingle(x0, x1) let minTint = anim.MinTint let maxTint = anim.MaxTint b.Allocate(pc + emitCount) for i = 0 to emitCount - 1 do let dir = rand.NextRotationDegrees(anim.VelocityAngleRange).Rotate(pe.Rotation) let index = pc + i b.timestamps.[index] <- time b.positions.[index] <- pe.Position + dir * anim.InitialDistance b.velocities.[index] <- let v = let speed = rand.NextSingle(anim.MinSpeed, anim.MaxSpeed) dir * speed + pe.Velocity v b.sizes.[index] <- size b.rotations.[index] <- rand.NextRotationDegrees(anim.RotationAngleRange).Rotate(dir) b.energies.[index] <- pe.Energy b.colors.[index] <- let color = let h = rand.NextSingle(anim.MinHue, anim.MaxHue) let s = rand.NextSingle(anim.MinSaturation, anim.MaxSaturation) let v = rand.NextSingle(anim.MinValue, anim.MaxValue) let c = HsvaFloat(h, s, v, 1.0f).ToRgbaFloat() let tint = let c = RgbaFloat.Lerp(minTint, maxTint, rand.NextSingle()) let tint = RgbaFloat.Lerp(RgbaFloat.White, pe.Color, anim.TintWeight) c.Multiply(tint) c.Multiply(tint) color b.opacities.[index] <- anim.Opacity b.texIndices.[index] <- 0 // Textures if anim.Textures.Length > 1 then for i = 0 to emitCount - 1 do b.texIndices.[pc + i] <- rand.NextInt32(anim.Textures.Length) pc <- pc + emitCount member c.Draw(layers : SpriteRenderer, atlas : TextureAtlas) = // Update tex bounds lookup for i = 0 to texBounds.Length - 1 do texBounds.[i] <- atlas.GetNormalizedBounds(anim.Textures.[i]) // Draw sprites let w = layers.GetVertices(anim.Layer) let baseSize = Vector2(anim.Width, anim.Height) * 0.5f let span = w.GetQuadSpan(pc) for i = 0 to pc - 1 do let p = b.positions.[i] let dir = b.rotations.[i] let scaling = b.sizes.[i] let fg = let opacity = b.opacities.[i] let color = b.colors.[i] color.MultiplyAlpha(opacity) let side = -dir.GetPerpendicular() let s = baseSize * scaling let dy = dir * s.Y let dx = side * s.X let p0 = p - dx + dy let p1 = p - dx - dy let p2 = p + dx - dy let p3 = p + dx + dy let texIndex = b.texIndices.[i] let tb = texBounds.[texIndex] let t0 = tb.Min let t2 = tb.Max let span = span.Slice(i * 4) span.[0] <- { Position = Vector3(p0.X, p0.Y, 0.0f) TexCoord = Vector2(t0.X, t0.Y) Color = fg } span.[1] <- { Position = Vector3(p1.X, p1.Y, 0.0f) TexCoord = Vector2(t2.X, t0.Y) Color = fg } span.[2] <- { Position = Vector3(p2.X, p2.Y, 0.0f) TexCoord = Vector2(t2.X, t2.Y) Color = fg } span.[3] <- { Position = Vector3(p3.X, p3.Y, 0.0f) TexCoord = Vector2(t0.X, t2.Y) Color = fg } w.Advance(span.Length) type ParticleSystem() = let sets = List() let groups = List() let layerDescriptors = HashSet() member c.ParticleCount = let mutable count = 0 for set in sets do count <- count + set.ParticleCount count member c.Clear() = for set in sets do set.Clear() member c.AddGroup(groupId, anims) = let group = anims |> Seq.map (fun anim -> let set = ParticleSet(anim) sets.Add(set) set) |> Seq.toArray while groups.Count <= groupId do groups.Add(Array.empty) groups.[groupId] <- group // Track the set of layers we're using for anim in anims do layerDescriptors.Add(anim.Layer.Untyped) |> ignore member c.Emit(emission : ParticleEmission) = if emission.GroupId < groups.Count then let group = groups.[emission.GroupId] for set in group do set.Emit(emission) member c.Update(deltaTime) = for set in sets do set.Update(deltaTime) member c.Draw(canvas : SpriteRenderer, atlas) = for set in sets do set.Draw(canvas, atlas) // If not automatically flushing on draw, we need to manually do so here. This // assume layers are used exclusively for particles, otherwise they would overwrite // anything previously flushed to the same buffer for desc in layerDescriptors do match desc.FlushMode with | NoFlush -> canvas.Flush(desc.LayerId) | FlushOnDraw -> () type ParticleSystem with member c.AddGroups(groups) = for group in groups do c.AddGroup(group.GroupId, group.Animations) ================================================ FILE: samples/Garnet.Toolkit/Picking.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.Buffers open System.Numerics open Garnet.Numerics [] type PickLayerDescriptor = { LayerId : int CameraId : int Primitive : Primitive FlushMode : SpriteFlushMode } [] type PickResult = { LayerId : int PrimitiveIndex : int WorldPosition : Vector2 } [] type PickResult<'a> = { Param : 'a LayerId : int PrimitiveIndex : int } type VertexPicking() = /// Returns index of first vertex contained in rect static member TryPickPoint(span : ReadOnlySpan, rect : Range2) = let mutable result = ValueNone let mutable i = 0 while result.IsNone && i < span.Length do let v = span.[i] if rect.Contains(v) then result <- ValueSome i i <- i + 1 result /// Returns index of first triangle containing point static member TryPickTriangle(span : ReadOnlySpan, p : Vector2) = let mutable result = ValueNone let mutable i = 0 while result.IsNone && i < span.Length do let v0 = span.[i + 0] let v1 = span.[i + 1] let v2 = span.[i + 2] if p.IsInTriangle(v0, v1, v2) then result <- ValueSome (i / 3) i <- i + 3 result /// Returns index of first quad containing point static member TryPickQuad(span : ReadOnlySpan, p : Vector2) = let mutable result = ValueNone let mutable i = 0 while result.IsNone && i < span.Length do let v0 = span.[i + 0] let v1 = span.[i + 1] let v2 = span.[i + 2] let v3 = span.[i + 3] if p.IsInTriangle(v0, v1, v2) || p.IsInTriangle(v0, v2, v3) then result <- ValueSome (i / 4) i <- i + 4 result type IPickLayer = abstract Descriptor : PickLayerDescriptor abstract WrittenVertexSpan : ReadOnlySpan abstract Clear : unit -> unit type PickLayer<'a>(desc : PickLayerDescriptor) = let values = ArrayBufferWriter<'a>() let vertices = ArrayBufferWriter() member c.Descriptor = desc member c.Values = values :> IBufferWriter<'a> member c.VertexWriter = vertices :> IBufferWriter member c.WrittenValueSpan = values.WrittenSpan member c.WrittenVertexSpan = vertices.WrittenSpan member c.Clear() = values.Clear() vertices.Clear() interface IPickLayer with member c.Descriptor = desc member c.WrittenVertexSpan = c.WrittenVertexSpan member c.Clear() = c.Clear() type PickLayerSet() = let layers = List() member c.GetLayer<'a>(desc : PickLayerDescriptor) = while layers.Count <= desc.LayerId do layers.Add(ValueNone) match layers.[desc.LayerId] with | ValueNone -> let layer = PickLayer<'a>(desc) layers.[desc.LayerId] <- ValueSome (layer :> IPickLayer) layer | ValueSome layer -> layer :?> PickLayer<'a> member c.GetValue<'a>(layerId, primitiveIndex) = let layer = layers.[layerId].Value :?> PickLayer<'a> layer.WrittenValueSpan.[primitiveIndex] member c.TryPick(cameras : CameraSet, layerId, normPos : Vector2) = if layerId >= layers.Count then ValueNone else match layers.[layerId] with | ValueNone -> ValueNone | ValueSome layer -> let span = layer.WrittenVertexSpan let viewport = cameras.[layer.Descriptor.CameraId] let worldPos = viewport.NormalizedToWorld(normPos) let primitiveResult = match layer.Descriptor.Primitive with | Triangle -> VertexPicking.TryPickTriangle(span, worldPos) | Quad -> VertexPicking.TryPickQuad(span, worldPos) match primitiveResult with | ValueNone -> ValueNone | ValueSome index -> ValueSome { LayerId = layerId PrimitiveIndex = index WorldPosition = worldPos } /// Returns index of primitive containing point, if any member c.TryPick(cameras : CameraSet, normPos : Vector2) = let mutable result = ValueNone let mutable i = layers.Count - 1 while result.IsNone && i >= 0 do result <- c.TryPick(cameras, i, normPos) i <- i - 1 result member c.PickAll(param, cameras : CameraSet, layerId, normRect : Range2, action) = if layerId < layers.Count then match layers.[layerId] with | ValueNone -> () | ValueSome layer -> let span = layer.WrittenVertexSpan let vertsPerPrimitive = Primitive.GetVertexCount(layer.Descriptor.Primitive) let viewport = cameras.[layer.Descriptor.CameraId] let worldRect = viewport.NormalizedToWorld(normRect) // Scan vertices let mutable vi = 0 while vi < span.Length do let v = span.[vi] if worldRect.Contains(v) then action { Param = param LayerId = layerId PrimitiveIndex = vi / vertsPerPrimitive } vi <- vi + 1 /// Returns index of primitive with a vertex contained within rect, if any member c.PickAll(param, cameras : CameraSet, normRect : Range2, action) = let mutable i = layers.Count - 1 while i >= 0 do c.PickAll(param, cameras, i, normRect, action) i <- i - 1 member c.Flush() = for i = 0 to layers.Count - 1 do match layers.[i] with | ValueNone -> () | ValueSome layer -> match layer.Descriptor.FlushMode with | NoFlush -> () | FlushOnDraw -> layer.Clear() ================================================ FILE: samples/Garnet.Toolkit/Pipelines.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.Numerics open Veldrid open Garnet.Composition [] type Blend = | Additive = 0 | Alpha = 1 | Override = 2 [] type Filtering = | Point = 0 | Linear = 1 [] type TexturePipelineDescriptor = { Blend : Blend Filtering : Filtering ShaderSet : ShaderSetDescriptor Texture : string } [] type TexturePipelineDescriptor<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType and 'v :> IVertex> = { Blend : Blend Filtering : Filtering ShaderSet : ShaderSetDescriptor<'v> Texture : string } with member c.Untyped : TexturePipelineDescriptor = { Blend = c.Blend Filtering = c.Filtering ShaderSet = c.ShaderSet.Untyped Texture = c.Texture } [] module internal GraphicsDeviceExtensions = type GraphicsDevice with member c.GetSampler(filtering) = match filtering with | Filtering.Point -> c.PointSampler | Filtering.Linear -> c.LinearSampler | x -> failwith $"Invalid filtering {x}" type ProjectionViewSet(device : GraphicsDevice, slot) = let factory = device.ResourceFactory let projBuffer = device.ResourceFactory.CreateBuffer( BufferDescription(uint32 sizeof, BufferUsage.UniformBuffer)) let viewBuffer = device.ResourceFactory.CreateBuffer( BufferDescription(uint32 sizeof, BufferUsage.UniformBuffer)) let projViewLayout = factory.CreateResourceLayout( ResourceLayoutDescription( ResourceLayoutElementDescription( "ProjectionBuffer", ResourceKind.UniformBuffer, ShaderStages.Vertex), ResourceLayoutElementDescription( "ViewBuffer", ResourceKind.UniformBuffer, ShaderStages.Vertex))) let projViewSet = factory.CreateResourceSet( ResourceSetDescription(projViewLayout, projBuffer, viewBuffer)) member c.Layout = projViewLayout member c.Apply(proj : Matrix4x4, view : Matrix4x4, cmds : CommandList) = cmds.UpdateBuffer(projBuffer, 0u, proj) cmds.UpdateBuffer(viewBuffer, 0u, view) cmds.SetGraphicsResourceSet(uint32 slot, projViewSet) member c.Dispose() = projViewSet.Dispose() projViewLayout.Dispose() projBuffer.Dispose() viewBuffer.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type WorldTextureSet(device : GraphicsDevice, surfaceTexture : Texture, slot, sampler) = let factory = device.ResourceFactory let worldBuffer = factory.CreateBuffer(BufferDescription(64u, BufferUsage.UniformBuffer)) let texTransformBuffer = factory.CreateBuffer(BufferDescription(64u, BufferUsage.UniformBuffer)) let worldTextureLayout = factory.CreateResourceLayout( ResourceLayoutDescription( ResourceLayoutElementDescription( "WorldBuffer", ResourceKind.UniformBuffer, ShaderStages.Vertex), ResourceLayoutElementDescription( "TexTransformBuffer", ResourceKind.UniformBuffer, ShaderStages.Vertex), ResourceLayoutElementDescription( "SurfaceTexture", ResourceKind.TextureReadOnly, ShaderStages.Fragment), ResourceLayoutElementDescription( "SurfaceSampler", ResourceKind.Sampler, ShaderStages.Fragment))) let surfaceTextureView = factory.CreateTextureView(surfaceTexture) let worldTextureSet = factory.CreateResourceSet( ResourceSetDescription( worldTextureLayout, worldBuffer, texTransformBuffer, surfaceTextureView, sampler)) member c.Layout = worldTextureLayout member c.Apply(world : Matrix4x4, texTransform : Matrix4x4, cmds : CommandList) = cmds.UpdateBuffer(worldBuffer, 0u, world) cmds.UpdateBuffer(texTransformBuffer, 0u, texTransform) cmds.SetGraphicsResourceSet(uint32 slot, worldTextureSet) member c.Dispose() = worldTextureSet.Dispose() worldTextureLayout.Dispose() texTransformBuffer.Dispose() worldBuffer.Dispose() surfaceTextureView.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type TextureTrianglePipeline(device, shaders : ShaderSet, texture : Texture, sampler, blendState, outputDesc) = let projView = new ProjectionViewSet(device, 0) let worldTexture = new WorldTextureSet(device, texture, 1, sampler) let layouts = [| projView.Layout worldTexture.Layout |] let pipeline = let desc = GraphicsPipelineDescription( BlendState = blendState, DepthStencilState = DepthStencilStateDescription.Disabled, RasterizerState = RasterizerStateDescription( cullMode = FaceCullMode.None, fillMode = PolygonFillMode.Solid, frontFace = FrontFace.Clockwise, depthClipEnabled = false, scissorTestEnabled = false), PrimitiveTopology = PrimitiveTopology.TriangleList, ResourceLayouts = layouts, ShaderSet = shaders.Description, Outputs = outputDesc) device.ResourceFactory.CreateGraphicsPipeline(desc) member c.Dispose() = pipeline.Dispose() projView.Dispose() worldTexture.Dispose() member c.SetPipeline(cmds : CommandList) = cmds.SetPipeline(pipeline) member c.SetProjectionView(projection, view, cmds) = projView.Apply(projection, view, cmds) member c.SetWorldTexture(world, texTransform, cmds) = worldTexture.Apply(world, texTransform, cmds) interface IDisposable with member c.Dispose() = c.Dispose() type TexturePipelineCache(device : GraphicsDevice, shaderCache : ShaderSetCache, cache : IResourceCache) = let solidTexture = device.CreateTextureRgba(1, 1, ReadOnlyMemory(Array.create 4 255uy)) let pipelines = Dictionary<_, TextureTrianglePipeline>() member c.GetPipeline(desc : TexturePipelineDescriptor, outputDesc) = let key = struct(desc, outputDesc) match pipelines.TryGetValue(key) with | true, pipeline -> pipeline | false, _ -> let sampler = device.GetSampler(desc.Filtering) let blend = match desc.Blend with | Blend.Additive -> BlendStateDescription.SingleAdditiveBlend | Blend.Alpha -> BlendStateDescription.SingleAlphaBlend | Blend.Override -> BlendStateDescription.SingleOverrideBlend | x -> failwith $"Invalid blend {x}" let shaders = shaderCache.GetOrCreate(device, desc.ShaderSet, cache) let texture = // Use a solid white texture as a fallback when none specified if String.IsNullOrEmpty(desc.Texture) then solidTexture else cache.LoadResource(desc.Texture) let pipeline = new TextureTrianglePipeline(device, shaders, texture, sampler, blend, outputDesc) pipelines.Add(key, pipeline) pipeline member c.Dispose() = solidTexture.Dispose() for pipeline in pipelines.Values do pipeline.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Toolkit/Rendering.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open Veldrid // Allow auto invalidate to avoid requiring extra call when every frame // is considered invalidated (for uses of manual mode, consider simple // turn-based games without animation or tools that don't need to be // constantly drawing. type Redraw = | Manual = 0 | Auto = 1 type RenderContext(commands : CommandList) = let frameBuffers = Stack() member c.Commands = commands member c.OutputDescription = frameBuffers.Peek().OutputDescription member c.PushFramebuffer(framebuffer) = frameBuffers.Push(framebuffer) commands.SetFramebuffer(framebuffer) member c.PopFramebuffer() = frameBuffers.Pop() |> ignore if frameBuffers.Count > 0 then commands.SetFramebuffer(frameBuffers.Peek()) type Renderer(device : GraphicsDevice, redraw) = let commands = device.ResourceFactory.CreateCommandList() let context = RenderContext(commands) let mutable width = 0 let mutable height = 0 let mutable valid = false member c.Context = context member c.Invalidate() = valid <- false member c.BeginDraw(newWidth : int, newHeight : int, bgColor) = let resized = newWidth <> width || newHeight <> height if resized then device.ResizeMainWindow(uint32 newWidth, uint32 newHeight) width <- newWidth height <- newHeight // Only proceed if something to redraw if valid && not resized then false else commands.Begin() // We want to render directly to the output window context.PushFramebuffer(device.SwapchainFramebuffer) // Clear viewports commands.ClearColorTarget(0u, bgColor) // Mark valid if using manual redraw match redraw with | Redraw.Auto -> () | Redraw.Manual | _ -> valid <- true true member c.EndDraw() = // End() must be called before commands can be submitted for execution. commands.End() device.SubmitCommands(commands) // Once commands have been submitted, the rendered image can be presented to // the application window. device.SwapBuffers() context.PopFramebuffer() member c.Dispose() = device.WaitForIdle() commands.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Toolkit/Requests.fs ================================================ namespace Garnet.Composition open System.Collections.Generic open Garnet.Composition.Comparisons open Garnet.Composition /// Useful for linking response messages back to their corresponding /// request message. [] type RequestId = RequestId of uint64 with static member Undefined = RequestId 0UL [] module RequestTrackingExtensions = type private RequestTracker() = let requests = Dictionary() let mutable count = 0UL member c.Clear() = requests.Clear() member c.Create(waitingCount) = // start at one count <- count + 1UL let requestId = RequestId count requests.Add(requestId, waitingCount) requestId member c.Complete(requestId) = match requests.TryGetValue(requestId) with | false, _ -> false | true, waitingCount -> if waitingCount = 1 then // if this is the last response, request is complete requests.Remove(requestId) |> ignore true else // otherwise decrement counter requests.[requestId] <- waitingCount - 1 false type Container with member c.CreateRequest(waitingCount) = c.Get().Create(waitingCount) member c.ClearRequests() = c.Get().Clear() member c.CompleteRequest(requestId) = c.Get().Complete(requestId) ================================================ FILE: samples/Garnet.Toolkit/Serialization.fs ================================================ namespace Garnet.Composition open System open System.IO open Microsoft.FSharp.Reflection open Newtonsoft.Json open Veldrid open Garnet.Numerics module private JsonSerialization = // type RgbaFloatConverter() = // inherit JsonConverter() // override _.WriteJson(writer : JsonWriter, value : RgbaFloat, _ : JsonSerializer) = // writer.WriteValue(value.ToRgbaByte().ToString()) // override _.ReadJson(reader, objectType, existingValue, hasExistingValue, serializer) = // let s = string reader.Value // RgbaFloat.Parse s // http://gorodinski.com/blog/2013/01/05/json-dot-net-type-converters-for-f-option-list-tuple/ type OptionConverter() = inherit JsonConverter() override x.CanConvert(t) = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> override x.WriteJson(writer, value, serializer) = let value = if value = null then null else let _,fields = FSharpValue.GetUnionFields(value, value.GetType()) fields.[0] serializer.Serialize(writer, value) override x.ReadJson(reader, t, existingValue, serializer) = let innerType = t.GetGenericArguments().[0] let innerType = if innerType.IsValueType then (typedefof>).MakeGenericType([|innerType|]) else innerType let value = serializer.Deserialize(reader, innerType) let cases = FSharpType.GetUnionCases(t) if value = null then FSharpValue.MakeUnion(cases.[0], [||]) else FSharpValue.MakeUnion(cases.[1], [|value|]) let defaultSettings = let settings = JsonSerializerSettings( Formatting = Formatting.Indented, NullValueHandling = NullValueHandling.Ignore) settings.Converters.Add(OptionConverter()) //settings.Converters.Add(RgbaFloatConverter()) settings [] module LoadingExtensions = type IStreamSource with member c.LoadText(key) = use stream = c.Open(key) use reader = new StreamReader(stream) reader.ReadToEnd() member c.LoadJson<'a>(key, settings : JsonSerializerSettings) = let json = c.LoadText(key) try JsonConvert.DeserializeObject<'a>(json, settings) with ex -> raise (exn($"Could not load JSON from {key} as {typeof<'a>.Name}", ex)) member c.LoadJson<'a> key = c.LoadJson<'a>(key, JsonSerialization.defaultSettings) member c.LoadJson<'a>(key, cache : IResourceCache, settings) = let resource = c.LoadJson<'a>(key, settings) cache.AddResource(key, resource) member c.LoadJson<'a>(key, cache) = c.LoadJson<'a>(key, cache, JsonSerialization.defaultSettings) type TextLoader() = interface IResourceLoader with member c.Load(folder, cache, key) = cache.AddResource(key, folder.LoadText(key)) type JsonLoader<'a>(settings) = new() = JsonLoader<'a>(JsonSerialization.defaultSettings) interface IResourceLoader with member c.Load(folder, cache, key) = folder.LoadJson<'a>(key, cache, settings) [] module LoaderExtensions = type ResourceCache with member c.AddTextLoaders() = c.AddLoader(".json", TextLoader()) c.AddLoader(".txt", TextLoader()) ================================================ FILE: samples/Garnet.Toolkit/Shaders.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.IO open System.Text open Veldrid open Garnet.Composition open Veldrid.SPIRV type IVertex = abstract Layout : VertexLayoutDescription type Vertex<'v when 'v : struct and 'v :> IVertex> = static member Layout = Unchecked.defaultof<'v>.Layout [] type ShaderSetDescriptor = { VertexShader : string FragmentShader : string Layout : VertexLayoutDescription } [] type ShaderSetDescriptor<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType and 'v :> IVertex> = { VertexShader : string FragmentShader : string } with member c.Untyped = { VertexShader = c.VertexShader FragmentShader = c.FragmentShader Layout = Vertex<'v>.Layout } type ShaderSet(device : GraphicsDevice, vert : ShaderDescription, frag : ShaderDescription, layout : VertexLayoutDescription, isCompiled) = let shaders = try if not isCompiled then device.ResourceFactory.CreateFromSpirv(vert, frag) else let vsCode = vert.ShaderBytes let fsCode = frag.ShaderBytes let vertexShader = device.ResourceFactory.CreateShader(ShaderDescription(vert.Stage, vsCode, vert.EntryPoint)) let fragmentShader = device.ResourceFactory.CreateShader(ShaderDescription(frag.Stage, fsCode, frag.EntryPoint)) [| vertexShader; fragmentShader |] with ex -> let msg = let vertStr = Encoding.UTF8.GetString(vert.ShaderBytes) let fragStr = Encoding.UTF8.GetString(frag.ShaderBytes) "Could not create shaders:\n" + $"Vertex ({vert.ShaderBytes.Length} bytes):\n{vertStr}\n" + $"Fragment ({frag.ShaderBytes.Length} bytes):\n{fragStr}" raise (Exception(msg, ex)) member c.Description = ShaderSetDescription( vertexLayouts = [| layout |], shaders = shaders) member c.Dispose() = for shader in shaders do shader.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() module private ShaderFileExtension = let stages = [| ".vert", ShaderStages.Vertex ".tesc", ShaderStages.TessellationControl ".tese", ShaderStages.TessellationEvaluation ".geom", ShaderStages.Geometry ".frag", ShaderStages.Fragment ".comp", ShaderStages.Compute |] let extensionFilter = stages |> Array.map (fun (extension, _) -> "*" + extension) |> String.concat "," let extensionToStage = let dict = Dictionary() for extension, stage in stages do dict.[extension] <- stage dict :> IReadOnlyDictionary<_,_> [] module ShaderExtensions = type Shader with static member GetCompilationTarget(backend) = match backend with | GraphicsBackend.Direct3D11 -> CrossCompileTarget.HLSL | GraphicsBackend.OpenGL -> CrossCompileTarget.GLSL | GraphicsBackend.Metal -> CrossCompileTarget.MSL | GraphicsBackend.OpenGLES -> CrossCompileTarget.ESSL | _ -> raise (SpirvCompilationException($"Invalid GraphicsBackend: {backend}")) static member GetBytecodeExtension(backend) = match backend with | GraphicsBackend.Direct3D11 -> ".hlsl.bytes" | GraphicsBackend.Vulkan -> ".spv" | GraphicsBackend.OpenGL | GraphicsBackend.OpenGLES -> raise (InvalidOperationException("OpenGL and OpenGLES do not support shader bytecode.")) | _ -> raise (Exception($"Invalid GraphicsBackend: {backend}")) static member GetShaderBytes(backend, code : string) = match backend with | GraphicsBackend.Direct3D11 | GraphicsBackend.OpenGL | GraphicsBackend.OpenGLES -> Encoding.ASCII.GetBytes(code) | GraphicsBackend.Metal -> Encoding.UTF8.GetBytes(code) | _ -> raise (Exception($"Invalid GraphicsBackend: {backend}")) static member TryGetStage(extension) = match ShaderFileExtension.extensionToStage.TryGetValue(extension) with | true, stage -> ValueSome stage | false, _ -> ValueNone//raise (Exception($"Invalid extension: {extension}")) static member Compile(vert, frag, backend) = let target = Shader.GetCompilationTarget(backend) let result = SpirvCompilation.CompileVertexFragment(vert, frag, target) let vsCode = Shader.GetShaderBytes(backend, result.VertexShader) let fsCode = Shader.GetShaderBytes(backend, result.FragmentShader) (vsCode, fsCode) type ShaderSetCache() = let cache = Dictionary() member c.TryGet(desc) = match cache.TryGetValue(desc) with | true, x -> ValueSome x | false, _ -> ValueNone member c.Add(name, shaderSet) = cache.Add(name, shaderSet) member c.Dispose() = for set in cache.Values do set.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() type ShaderResource = { Description : ShaderDescription IsCompiled : bool } with static member FromStream(stage, isCompiled, stream : Stream) = let ms = new MemoryStream() stream.CopyTo(ms) { Description = ShaderDescription(stage, ms.ToArray(), "main") IsCompiled = isCompiled } type ShaderLoader(backend : GraphicsBackend, stage) = interface IResourceLoader with /// Key should be the base shader without backend-specific extension, e.g. shader.vert member c.Load(folder, cache, key) = // First look for a compiled shader with the backend-specific extension let extension = Shader.GetBytecodeExtension(backend) let bytecodePath = key + extension let result = folder.TryOpen(bytecodePath) use stream = match result with | ValueSome x -> x | ValueNone -> // If backend-specific file was not found, fallback to original file folder.Open(key) let resource = ShaderResource.FromStream(stage, result.IsSome, stream) cache.AddResource(key, resource) [] module ShaderLoadingExtensions = type IReadOnlyFolder with /// Key should be the base shader without backend-specific extension, e.g. shader.vert member c.LoadShader(key : string, backend : GraphicsBackend, cache : IResourceCache) = let extension = Path.GetExtension(key) match Shader.TryGetStage(extension) with | ValueNone -> () | ValueSome stage -> let loader = ShaderLoader(backend, stage) :> IResourceLoader loader.Load(c, cache, key) member c.LoadShadersFromFolder(path, backend, cache : IResourceCache) = for key in c.GetFiles(path) do c.LoadShader(key, backend, cache) [] module ShaderLoaderExtensions = type ResourceCache with member c.AddShaderLoaders(device : GraphicsDevice) = for extension, stage in ShaderFileExtension.stages do c.AddLoader(extension, ShaderLoader(device.BackendType, stage)) type ShaderSetCache with member c.GetOrCreate(device, desc, cache : IResourceCache) = match c.TryGet(desc) with | ValueSome x -> x | ValueNone -> let vert = cache.LoadResource(desc.VertexShader) let frag = cache.LoadResource(desc.FragmentShader) if vert.IsCompiled <> frag.IsCompiled then failwith $"Shaders must both be GLSL or compiled for the same backend: {desc.VertexShader}, {desc.FragmentShader}" let set = new ShaderSet(device, vert.Description, frag.Description, desc.Layout, vert.IsCompiled) c.Add(desc, set) set ================================================ FILE: samples/Garnet.Toolkit/Sprites.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.Numerics open Garnet.Numerics [] type Primitive = | Triangle | Quad type Primitive with static member GetVertexCount(primitive) = match primitive with | Triangle -> 3 | Quad -> 4 [] type SpriteFlushMode = | NoFlush | FlushOnDraw [] type SpriteLayerDescriptor = { LayerId : int CameraId : int Primitive : Primitive Pipeline : TexturePipelineDescriptor FlushMode : SpriteFlushMode } [] type SpriteLayerDescriptor<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType and 'v :> IVertex> = { LayerId : int CameraId : int Primitive : Primitive Pipeline : TexturePipelineDescriptor<'v> FlushMode : SpriteFlushMode } with member c.Untyped : SpriteLayerDescriptor = { LayerId = c.LayerId CameraId = c.CameraId Primitive = c.Primitive Pipeline = c.Pipeline.Untyped FlushMode = c.FlushMode } type Camera() = member val WorldTransform = Matrix4x4.Identity with get, set member val TextureTransform = Matrix4x4.Identity with get, set member val ViewTransform = Matrix4x4.Identity with get, set member val ProjectionTransform = Matrix4x4.Identity with get, set member c.GetNormalizedToWorld() = let projView = c.ViewTransform * c.ProjectionTransform projView.GetInverseOrIdentity() member c.NormalizedToWorld(normPos : Vector2) = let xf = c.GetNormalizedToWorld() Vector2.Transform(normPos, xf) member c.NormalizedToWorld(rect : Range2) = let xf = c.GetNormalizedToWorld() let p0 = Vector2.Transform(rect.Min, xf) let p1 = Vector2.Transform(rect.Max, xf) Range2.Union(Range2.Point(p0), Range2.Point(p1)) type CameraSet() = let cameras = List() member c.Item with get i = while cameras.Count <= i do cameras.Add(Camera()) cameras.[i] [] type private SpriteLayer = { Descriptor : SpriteLayerDescriptor Vertices : IVertexBuffer } type SpriteRenderer(device, shaders, cache) = let indexes = new QuadIndexBuffer(device) let pipelines = new TexturePipelineCache(device, shaders, cache) let layers = List() member c.VertexCount = let mutable count = 0 for layer in layers do match layer with | ValueNone -> () | ValueSome layer -> count <- count + layer.Vertices.VertexCount count member c.GetVertices<'v when 'v : struct and 'v : (new : unit -> 'v) and 'v :> ValueType and 'v :> IVertex>(desc : SpriteLayerDescriptor<'v>) = while layers.Count <= desc.LayerId do layers.Add(ValueNone) match layers.[desc.LayerId] with | ValueNone -> let vertices = new VertexBuffer<'v>(device) let layer = { Descriptor = desc.Untyped Vertices = vertices } layers.[desc.LayerId] <- ValueSome layer vertices | ValueSome layer -> layer.Vertices :?> VertexBuffer<'v> member c.Flush(layerId) = if layerId < layers.Count then match layers.[layerId] with | ValueSome layer -> layer.Vertices.Flush() | ValueNone -> () member c.Draw(context : RenderContext, cameras : CameraSet) = for layer in layers do match layer with | ValueNone -> () | ValueSome layer -> let desc = layer.Descriptor let vertices = layer.Vertices // Flush if needed match desc.FlushMode with | NoFlush -> () | FlushOnDraw -> vertices.Flush() // Proceed if not empty let vertexCount = vertices.VertexCount if vertexCount > 0 then // Set shader params let camera = cameras.[desc.CameraId] let pipeline = pipelines.GetPipeline(desc.Pipeline, context.OutputDescription) pipeline.SetPipeline(context.Commands) pipeline.SetProjectionView(camera.ProjectionTransform, camera.ViewTransform, context.Commands) pipeline.SetWorldTexture(camera.WorldTransform, camera.TextureTransform, context.Commands) // Draw primitives vertices.SetVertexBuffer(context.Commands) match desc.Primitive with | Quad -> indexes.Draw(context.Commands, vertexCount / 4) | Triangle -> context.Commands.Draw( vertexCount = uint32 vertexCount, instanceCount = 1u, vertexStart = 0u, instanceStart = 0u) member c.Dispose() = for layer in layers do match layer with | ValueNone -> () | ValueSome layer -> layer.Vertices.Dispose() pipelines.Dispose() indexes.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/Garnet.Toolkit/Systems.fs ================================================ namespace Garnet.Composition open System open System.IO open System.Runtime.CompilerServices open System.Reflection open Veldrid open Garnet.Input open Garnet.Graphics open Garnet.Audio open Garnet.Composition type AssetSettings = { AssetPath : string ArchiveExtension : string } with static member Default = { AssetPath = "assets" ArchiveExtension = ".dat" } [] type Systems = [] static member AddAssetsFolder(c : Container) = let folder = let settings = c.GetOrDefault(AssetSettings.Default) let path = Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location) let path = if String.IsNullOrEmpty(path) then "" else path // First look for asset folder, then fallback to an archive file let folderPath = Path.Combine(path, settings.AssetPath) let archivePath = Path.Combine(path, settings.AssetPath + settings.ArchiveExtension) if Directory.Exists(folderPath) then new FileFolder(folderPath) :> IReadOnlyFolder elif File.Exists(archivePath) then new ZipArchiveFolder(archivePath) :> IReadOnlyFolder else new FileFolder(path) :> IReadOnlyFolder let cache = c.Get() cache.SetFolder(folder) c.Set(folder) Disposable.Create [ folder :> IDisposable ] [] static member AddTextLoaders(c : Container) = let cache = c.Get() cache.AddTextLoaders() Disposable.Null [] static member AddGraphicsDevice(c : Container) = let settings = c.GetOrSetDefault(WindowSettings.Default) let ren = new WindowRenderer(settings) let shaders = new ShaderSetCache() c.Set(ren) c.Set(ren.Device) c.Set(ren.RenderContext) c.Set(shaders) Disposable.Create [ ren :> IDisposable shaders :> IDisposable ] [] static member AddGraphicsLoaders(c : Container) = let device = c.Get() let cache = c.Get() cache.AddShaderLoaders(device) cache.AddTextureLoaders(device) cache.AddFontLoaders() Disposable.Null [] static member AddWindowRendering(c : Container) = Disposable.Create [ c.On <| fun e -> let ren = c.Get() let inputs = c.Get() let deltaTime = float32 e.Update.DeltaTime / 1000.0f let isRunning = ren.Update(deltaTime, inputs) if not isRunning then c.Send(Closing()) c.On <| fun e -> let ren = c.Get() c.Start <| seq { let draw = { Update = e.Update ViewSize = ren.Size } yield c.Wait(draw) // This check must come after since the drawing stage may // have invalidated renderer, causing check to pass. if ren.BeginDraw() then yield c.Wait(PushDrawCommands()) ren.EndDraw() } ] [] static member AddInputPublishing(c : Container) = Disposable.Create [ c.On <| fun _ -> let inputs = c.Get() for e in inputs.KeyUpEvents do c.Send e for e in inputs.KeyDownEvents do c.Send e c.Send { devicePos = inputs.MousePosition deviceDelta = inputs.MouseDelta pos = inputs.NormalizedMousePosition delta = inputs.NormalizedMouseDelta modifiers = inputs.Modifiers } if abs inputs.WheelDelta > 0.0f then c.Send { modifiers = int inputs.Modifiers wheel = int inputs.WheelDelta } for e in inputs.MouseDownEvents do c.Send { devicePos = inputs.MousePosition pos = inputs.NormalizedMousePosition button = e modifiers = inputs.Modifiers } for e in inputs.MouseUpEvents do c.Send { devicePos = inputs.MousePosition pos = inputs.NormalizedMousePosition button = e } ] [] static member AddSpriteDrawing(c : Container) = let sprites = let device = c.Get() let shaders = c.Get() let cache = c.Get() new SpriteRenderer(device, shaders, cache) c.Set(sprites) Disposable.Create [ sprites :> IDisposable c.On <| fun _ -> let context = c.Get() let cameras = c.Get() sprites.Draw(context, cameras) ] [] static member AddAudioDevice(c : Container) = let device = new AudioDevice() c.Set(device) Disposable.Create [ device :> IDisposable ] [] static member AddAudioLoaders(c : Container) = let device = c.Get() let cache = c.Get() cache.AddAudioLoaders(device) Disposable.Null [] static member AddTickUpdate(c : Container) = let settings = c.GetOrSetDefault(TimingSettings.Default) let timer = FixedUpdateTimer(settings) Disposable.Create [ c.On <| fun _ -> // Send initial request for tick let settings = c.Get() if settings.ClockActorId.IsDefined then c.Send(settings.ClockActorId, { DueTime = settings.MinDeltaTime }) c.On <| fun e -> c.Start <| seq { let settings = c.Get() timer.SetSettings(settings) timer.SetTime(e.Time) let update = timer.TryTakeUpdate() match update with | ValueNone -> () | ValueSome e -> // Handle input yield c.Wait { Update = e } yield c.Wait { Time = e.Time } // Run fixed updates while timer.HasFixedUpdate do let e = timer.TakeFixedUpdate() yield c.Wait(e) match update with | ValueNone -> () | ValueSome e -> // Run variable update c.Step(e.DeltaTime) yield c.Wait(e) yield c.Wait { Update = e } // Request next update if settings.ClockActorId.IsDefined then c.Send(settings.ClockActorId, { DueTime = e.Time + settings.MinDeltaTime }) } ] [] static member AddGraphics(c : Container) = Disposable.Create [ c.AddGraphicsDevice() c.AddGraphicsLoaders() c.AddWindowRendering() c.AddSpriteDrawing() c.AddInputPublishing() ] [] static member AddDefaultSystems(c : Container) = Disposable.Create [ c.AddAssetsFolder() c.AddTextLoaders() c.AddGraphics() c.AddAudioDevice() c.AddAudioLoaders() c.AddTickUpdate() ] ================================================ FILE: samples/Garnet.Toolkit/Textures.fs ================================================ namespace Garnet.Graphics open System open System.Collections.Generic open System.Runtime.InteropServices open Veldrid open SixLabors.ImageSharp open SixLabors.ImageSharp.PixelFormats open Garnet.Numerics open Garnet.Composition type TextureAtlasEntry = { Bounds : Range2i NormalizedBounds : Range2 } module internal TextureLoading = let getMipSize original mipLevel = original >>> mipLevel |> max 1 let getFormatSize format = match format with | PixelFormat.R8_G8_B8_A8_UNorm -> 4 | PixelFormat.BC3_UNorm -> 1 | _ -> failwithf $"Unsupported format %A{format}" [] module private Packing = let isContainedIn (a : Range2i) (b : Range2i) = a.X.Min >= b.X.Min && a.Y.Min >= b.Y.Min && a.X.Max <= b.X.Max && a.Y.Max <= b.Y.Max let isOverlapping (a : Range2i) (b : Range2i) = a.X.Min >= b.X.Max || a.X.Max <= b.X.Min || a.Y.Min >= b.Y.Max || a.Y.Max <= b.Y.Min // http://wiki.unity3d.com/index.php?title=MaxRectsBinPack type MaxRectsBinPack(size : Vector2i) = let w = max 0 size.X let h = max 0 size.Y let n = Range2i(Vector2i.Zero, Vector2i(w, h)) let usedRects = List() let freeRects = List([ n ]) member c.Entries = usedRects :> seq<_> member c.Insert(key, size : Vector2i) = if size.X <= 0 || size.Y <= 0 then None else match c.TryFindPositionForNewNodeBestAreaFit(size) with | Some rect -> c.PlaceRect(key, rect) |> Some | None -> None member private c.PlaceRect(key, newNode) = let mutable n = freeRects.Count let mutable i = 0 while i < n do if c.SplitFreeNode(freeRects.[i], newNode) then freeRects.RemoveAt(i) i <- i - 1 n <- n - 1 i <- i + 1 c.PruneFreeList() usedRects.Add(key, newNode) newNode member private c.TryFindPositionForNewNodeBestAreaFit(size : Vector2i) = //(int width, int height, ref int bestAreaFit, ref int bestShortSideFit) let mutable bestNode = None let mutable bestAreaFit = Int64.MaxValue let mutable bestShortSideFit = Int32.MaxValue for rect in freeRects do let areaFit = int64 rect.X.Size * int64 rect.Y.Size - int64 size.X * int64 size.Y // Try to place the rectangle in upright (non-flipped) orientation. if (rect.X.Size >= size.X && rect.Y.Size >= size.Y) then let leftoverHoriz = abs (rect.X.Size - size.X) let leftoverVert = abs (rect.Y.Size - size.Y) let shortSideFit = min leftoverHoriz leftoverVert if areaFit < bestAreaFit || (areaFit = bestAreaFit && shortSideFit < bestShortSideFit) then bestNode <- Some (Range2i.Sized(rect.Min, size)) bestShortSideFit <- shortSideFit bestAreaFit <- areaFit bestNode member private c.SplitFreeNode(free : Range2i, used : Range2i) = // Test with SAT if the rectangles even intersect. if isOverlapping used free then false else if (used.X.Min < free.X.Max && used.X.Max > free.X.Min) then // New node at the top side of the used node. if (used.Y.Min > free.Y.Min && used.Y.Min < free.Y.Max) then freeRects.Add(Range2i(free.X, (Rangei.Sized(free.Y.Min, used.Y.Min - free.Y.Min)))) // New node at the bottom side of the used node. if (used.Y.Max < free.Y.Max) then freeRects.Add(Range2i(free.X, (Rangei.Sized(used.Y.Max, free.Y.Max - used.Y.Max)))) if (used.Y.Min < free.Y.Max && used.Y.Max > free.Y.Min) then // New node at the left side of the used node. if (used.X.Min > free.X.Min && used.X.Min < free.X.Max) then freeRects.Add(Range2i(Rangei.Sized(free.X.Min, used.X.Min - free.X.Min), free.Y)) // New node at the right side of the used node. if (used.X.Max < free.X.Max) then freeRects.Add(Range2i(Rangei.Sized(used.X.Max, free.X.Max - used.X.Max), free.Y)) true member private c.PruneFreeList() = let mutable isDone = false let mutable i = 0 while not isDone && i < freeRects.Count do let mutable j = i + 1 while not isDone && j < freeRects.Count do if isContainedIn freeRects.[i] freeRects.[j] then freeRects.RemoveAt(i) i <- i - 1 isDone <- true elif isContainedIn freeRects.[j] freeRects.[i] then freeRects.RemoveAt(j) j <- j - 1 j <- j + 1 i <- i + 1 type TextureAtlas(size : Vector2i, entries : (string * Range2i) seq) = let dict = let size = size.ToVector2() let dict = Dictionary() for key, rect in entries do let p0 = rect.Min.ToVector2() / size let p1 = rect.Max.ToVector2() / size let tex = { Bounds = rect NormalizedBounds = Range2(p0, p1) } dict.[key] <- tex dict.[key.ToLowerInvariant()] <- tex dict member c.Size = size member c.Item with get key = match dict.TryGetValue(key) with | false, _ -> failwith $"Could not find {key} in atlas" | true, x -> x member c.GetNormalizedBounds(key) = match dict.TryGetValue(key) with | false, _ -> Range2.Zero | true, x -> x.NormalizedBounds [] module TextureExtensions = type Texture with member texture.Load(device : GraphicsDevice, desc : TextureDescription, data : ReadOnlyMemory) = let factory = device.ResourceFactory // create staging texture use staging = factory.CreateTexture( TextureDescription( desc.Width, desc.Height, desc.Depth, desc.MipLevels, desc.ArrayLayers, desc.Format, TextureUsage.Staging, desc.Type)) // copy from buffer to staging use handle = data.Pin() let formatSize = TextureLoading.getFormatSize desc.Format let mutable offset = 0 for level = 0 to int desc.MipLevels - 1 do let mipWidth = TextureLoading.getMipSize (int desc.Width) level let mipHeight = TextureLoading.getMipSize (int desc.Height) level let mipDepth = TextureLoading.getMipSize (int desc.Depth) level let subresourceSize = mipWidth * mipHeight * mipDepth * formatSize for layer = 0 to int desc.ArrayLayers - 1 do device.UpdateTexture( staging, IntPtr handle.Pointer + nativeint offset, uint32 subresourceSize, 0u, 0u, 0u, uint32 mipWidth, uint32 mipHeight, uint32 mipDepth, uint32 level, uint32 layer) offset <- offset + subresourceSize // copy from staging to final use cl = factory.CreateCommandList() cl.Begin() cl.CopyTexture(staging, texture) cl.End() device.SubmitCommands(cl) texture type GraphicsDevice with member device.CreateTexture(desc : TextureDescription, data) = let texture = device.ResourceFactory.CreateTexture(desc) texture.Load(device, desc, data) member device.CreateTextureRgba(width, height, data) = let desc = TextureDescription( Width = uint32 width, Height = uint32 height, Depth = 1u, MipLevels = 1u, ArrayLayers = 1u, Format = PixelFormat.R8_G8_B8_A8_UNorm, Usage = TextureUsage.Sampled, Type = TextureType.Texture2D) device.CreateTexture(desc, data) member device.CreateTexture(image : Image) = let w = image.Width let h = image.Height let bytes = Array.zeroCreate(w * h * 4) for y = 0 to h - 1 do let row = image.GetPixelRowSpan(y) let src = MemoryMarshal.Cast(row) let dest = bytes.AsSpan().Slice(w * 4 * y, w * 4) src.CopyTo(dest) device.CreateTextureRgba(image.Width, image.Height, ReadOnlyMemory(bytes)) member device.CreateTextureAtlas(atlasWidth, atlasHeight, images : (string * Image) seq) = let padding = 1 let bpp = 4 // Pack textures into atlas buffer let bytes = Array.zeroCreate(atlasWidth * atlasHeight * 4) let packer = MaxRectsBinPack(Vector2i(atlasWidth, atlasHeight)) let getIndex x y = (y * atlasWidth + x) * bpp let span = bytes.AsSpan() for key, image in images do let size = Vector2i(image.Width, image.Height) + padding * 2 match packer.Insert(key, size) with | None -> failwithf $"Could not pack texture %s{key}" | Some rect -> let w = image.Width let h = image.Height let rowSize = w * bpp for y = 0 to h - 1 do let row = image.GetPixelRowSpan(y) let src = MemoryMarshal.Cast(row) let xDest = rect.Min.X + padding let yDest = rect.Min.Y + y + padding let start = getIndex xDest yDest let dest = span.Slice(start, rowSize) src.CopyTo(dest) let x0 = rect.Min.X let x3 = rect.Max.X - 1 let x1 = x0 + padding let x2 = x3 - padding let y0 = rect.Min.Y let y3 = rect.Max.Y - 1 let y1 = y0 + padding let y2 = y3 - padding // Copy first and last rows to padding span.Slice(getIndex x1 y1, rowSize).CopyTo(span.Slice(getIndex x1 y0, rowSize)) span.Slice(getIndex x1 y2, rowSize).CopyTo(span.Slice(getIndex x1 y3, rowSize)) for y = rect.Min.Y to rect.Max.Y - 1 do // Copy first and last columns to padding span.Slice(getIndex x1 y, bpp).CopyTo(span.Slice(getIndex x0 y, bpp)) span.Slice(getIndex x2 y, bpp).CopyTo(span.Slice(getIndex x3 y, bpp)) // Create device texture let desc = TextureDescription( Width = uint32 atlasWidth, Height = uint32 atlasHeight, Depth = 1u, MipLevels = 1u, ArrayLayers = 1u, Format = PixelFormat.R8_G8_B8_A8_UNorm, Usage = TextureUsage.Sampled, Type = TextureType.Texture2D) let texture = device.CreateTexture(desc, ReadOnlyMemory(bytes)) // Remove padding from entries let entries = packer.Entries |> Seq.map (fun (key, rect) -> key, rect.Expand(Vector2i.One * -padding)) let size = Vector2i(int texture.Width, int texture.Height) TextureAtlas(size, entries), texture type JsonTextureEntry = { Name : string X : int Y : int Width : int Height : int Padding : int } type JsonTextureAtlas = { Width : int Height : int UndefinedName : string Textures : JsonTextureEntry[] } [] module TextureLoadingExtensions = let private getTexBounds (t : JsonTextureEntry) = // let tc0 = Vector2i(tex.X, tex.Y) // let tc1 = tc0 + Vector2i(tex.Width, tex.Height) // let padding = Vector2i.One * tex.Padding // let p0 = tc0 + padding // let p1 = tc1 - padding // Range2i(Vector2i(p0.X, p1.Y), Vector2i(p1.X, p0.Y)) Range2i.Sized(Vector2i(t.X, t.Y), Vector2i(t.Width, t.Height)) .Expand(Vector2i.One * -t.Padding) type IStreamSource with member c.LoadImage(key) = use stream = c.Open(key) Image.Load(stream) member c.LoadTexture(device : GraphicsDevice, key) = let image = c.LoadImage(key) device.CreateTexture(image) member c.LoadTexture(device : GraphicsDevice, key, cache : IResourceCache) = let texture = c.LoadTexture(device, key) cache.AddResource(key, texture) member c.LoadTextureAtlas(key) = let atlas = c.LoadJson(key) let entries = atlas.Textures |> Seq.map (fun t -> t.Name, getTexBounds t) TextureAtlas(Vector2i(atlas.Width, atlas.Height), entries) type IReadOnlyFolder with member c.LoadTextureAtlasFromFolder(device : GraphicsDevice, path, atlasWidth, atlasHeight) = // If this is a folder, create atlas on the fly from images within the folder let images = c.GetFiles(path) |> Seq.map (fun file -> // Make the keys relative within the atlas let key = file.Replace(path, "").TrimStart('/') key, c.LoadImage(file)) device.CreateTextureAtlas(atlasWidth, atlasHeight, images) member c.LoadTextureAtlasFromFolder(device, key, atlasWidth, atlasHeight, cache : IResourceCache) = let atlas, texture = c.LoadTextureAtlasFromFolder(device, key, atlasWidth, atlasHeight) cache.AddResource(key, atlas) cache.AddResource(key, texture) type TextureAtlasLoader() = interface IResourceLoader with member c.Load(folder, cache, key) = let atlas = folder.LoadTextureAtlas(key) cache.AddResource(key, atlas) type TextureLoader(device) = interface IResourceLoader with member c.Load(folder, cache, key) = let texture = folder.LoadTexture(device, key) cache.AddResource(key, texture) [] module TextureLoaderExtensions = type ResourceCache with member c.AddTextureAtlasLoaders() = c.AddLoader(".atlas.json", TextureAtlasLoader()) member c.AddTextureLoaders(device) = c.AddLoader(".jpg", TextureLoader(device)) c.AddLoader(".png", TextureLoader(device)) ================================================ FILE: samples/Garnet.Toolkit/Tiling.fs ================================================ namespace Garnet.Graphics open System open System.Buffers open System.Numerics open System.Runtime.CompilerServices [] type TileVertexSpanExtensions = [] static member DrawTile(span : Span, x0, y0, x1, y1, tx, ty, fg, bg) = let tx0 = float32 tx let ty0 = float32 ty let tx1 = tx0 + 1.0f let ty1 = ty0 + 1.0f let px0 = float32 x0 let py0 = float32 y0 let px1 = float32 x1 let py1 = float32 y1 span.[0] <- { Position = Vector3(px0, py0, 0.0f) TexCoord = Vector2(tx0, ty0) Foreground = fg Background = bg } span.[1] <- { Position = Vector3(px1, py0, 0.0f) TexCoord = Vector2(tx1, ty0) Foreground = fg Background = bg } span.[2] <- { Position = Vector3(px1, py1, 0.0f) TexCoord = Vector2(tx1, ty1) Foreground = fg Background = bg } span.[3] <- { Position = Vector3(px0, py1, 0.0f) TexCoord = Vector2(tx0, ty1) Foreground = fg Background = bg } [] static member DrawTile(span : Span, x, y, tx, ty, fg, bg) = span.DrawTile(x, y, x + 1, y + 1, tx, ty, fg, bg) [] static member DrawTile(span : Span, x0, y0, x1, y1, ch : char, fg, bg) = let tileId = int ch let tx = tileId &&& 0xf let ty = tileId >>> 4 span.DrawTile(x0, y0, x1, y1, tx, ty, fg, bg) [] static member DrawTile(span : Span, x, y, ch : char, fg, bg) = span.DrawTile(x, y, x + 1, y + 1, ch, fg, bg) [] type TileVertexBufferWriterExtensions = [] static member GetTileSpan(w : IBufferWriter, tileCount) = let vertexCount = tileCount * 4 w.GetSpan(vertexCount).Slice(0, vertexCount) [] static member DrawTile(w : IBufferWriter, x, y, ch, fg, bg) = let span = w.GetTileSpan(1) span.DrawTile(x, y, ch, fg, bg) w.Advance(span.Length) [] static member DrawTileText(w : IBufferWriter, x0, y0, str : string, fg, bg) = let span = w.GetTileSpan(str.Length) for i = 0 to str.Length - 1 do span.Slice(i * 4).DrawTile(x0 + i, y0, str.[i], fg, bg) w.Advance(span.Length) [] static member DrawTileRect(w : IBufferWriter, x0, y0, x1, y1, fg) = let span = w.GetTileSpan(1) span.DrawTile(x0, y0, x1, y1, '\u00db', fg, fg) w.Advance(span.Length) [] static member DrawTileTextBorder(w : IBufferWriter, x0, y0, x1, y1, fg, bg) = let x1 = x1 - 1 let y1 = y1 - 1 w.DrawTile(x0, y0, '\u00da', fg, bg) w.DrawTile(x1, y0, '\u00bf', fg, bg) w.DrawTile(x0, y1, '\u00c0', fg, bg) w.DrawTile(x1, y1, '\u00d9', fg, bg) for x = x0 + 1 to x1 - 1 do w.DrawTile(x, y0, '\u00c4', fg, bg) w.DrawTile(x, y1, '\u00c4', fg, bg) for y = y0 + 1 to y1 - 1 do w.DrawTile(x0, y, '\u00b3', fg, bg) w.DrawTile(x1, y, '\u00b3', fg, bg) ================================================ FILE: samples/Garnet.Toolkit/Timing.fs ================================================ namespace Garnet.Composition open System.Diagnostics type FpsGauge(updateInterval) = let mutable count = 0 let mutable maxValue = 0.0f let mutable lastUpdateTimestamp = 0L let mutable lastTimestamp = 0L let mutable resultMax = 0.0f let mutable resultFps = 0.0f member c.FramesPerSec = resultFps member c.MeanFrameMs = if resultFps > 0.0f then 1000.0f / resultFps else 0.0f member c.MaxFrameMs = resultMax * 1000.0f member c.Reset() = count <- 0 maxValue <- 0.0f lastTimestamp <- 0L lastUpdateTimestamp <- 0L resultMax <- 0.0f resultFps <- 0.0f member c.Update(timestamp) = let deltaSec = let delta = timestamp - lastTimestamp float32 (float delta / float Stopwatch.Frequency) let deltaUpdateSec = let delta = timestamp - lastUpdateTimestamp float32 (float delta / float Stopwatch.Frequency) lastUpdateTimestamp <- timestamp maxValue <- max maxValue deltaUpdateSec count <- count + 1 if deltaSec >= updateInterval then resultFps <- float32 count / float32 deltaSec resultMax <- maxValue lastTimestamp <- timestamp maxValue <- 0.0f count <- 0 type ScalarGauge(updateInterval) = let mutable count = 0 let mutable lastTimestamp = 0L let mutable total = 0.0f let mutable current = 0.0f member c.Current = current member c.Reset() = count <- 0 lastTimestamp <- 0L total <- 0.0f current <- 0.0f member c.Update(timestamp, value) = let delta = timestamp - lastTimestamp let deltaSec = float32 (float delta / float Stopwatch.Frequency) count <- count + 1 total <- total + value if deltaSec >= updateInterval then lastTimestamp <- timestamp current <- total / float32 count count <- 0 total <- 0.0f [] type TimingSettings = { MinDeltaTime : int64 MaxDeltaTime : int64 FixedDeltaTime : int64 IsRunning : bool ClockActorId : ActorId } with static member Default = { MinDeltaTime = 0L MaxDeltaTime = 250L FixedDeltaTime = 16L IsRunning = true ClockActorId = ActorId.Undefined } type FixedUpdateTimer(settings) = let mutable settings = settings let mutable lastTime = 0L let mutable accumulatedTime = 0L let mutable accumulatedFixedTime = 0L let mutable variableTime = 0L let mutable variableDeltaTime = 0L let mutable fixedTime = 0L let mutable frameCount = 0L member c.HasUpdate = accumulatedTime >= settings.MinDeltaTime member c.HasFixedUpdate = accumulatedFixedTime >= settings.FixedDeltaTime && settings.IsRunning member c.SetSettings(newSettings) = settings <- newSettings member c.SetTime(time) = let frameTime = min (time - lastTime) settings.MaxDeltaTime lastTime <- time if settings.IsRunning then accumulatedTime <- accumulatedTime + frameTime accumulatedFixedTime <- accumulatedFixedTime + frameTime variableTime <- variableTime + frameTime variableDeltaTime <- frameTime member c.TakeFixedUpdate() = let e = { FixedFrameNumber = fixedTime / settings.FixedDeltaTime FixedTime = fixedTime FixedDeltaTime = settings.FixedDeltaTime Time = lastTime } fixedTime <- fixedTime + settings.FixedDeltaTime accumulatedFixedTime <- accumulatedFixedTime - settings.FixedDeltaTime e /// Should be called after fixed update member c.TakeUpdate() = let e = { FrameNumber = frameCount FixedTime = fixedTime - settings.FixedDeltaTime FixedDeltaTime = settings.FixedDeltaTime Time = variableTime DeltaTime = variableDeltaTime } // Reset variable time rather than reducing by delta accumulatedTime <- 0L frameCount <- frameCount + 1L e member c.TryTakeUpdate() = if c.HasUpdate then ValueSome (c.TakeUpdate()) else ValueNone ================================================ FILE: samples/Garnet.Toolkit/Vertices.fs ================================================ namespace Garnet.Graphics open System open System.Buffers open System.Numerics open System.Runtime.CompilerServices open Veldrid open Garnet.Numerics [] type PositionColorVertex = { Position : Vector3 Color : RgbaFloat } with interface IVertex with member _.Layout = VertexLayoutDescription([| VertexElementDescription("Position", VertexElementFormat.Float3, VertexElementSemantic.TextureCoordinate) VertexElementDescription("Color", VertexElementFormat.Float4, VertexElementSemantic.TextureCoordinate) |]) [] type PositionTextureVertex = { Position : Vector3 TexCoord : Vector2 } with interface IVertex with member _.Layout = VertexLayoutDescription([| VertexElementDescription("Position", VertexElementFormat.Float3, VertexElementSemantic.TextureCoordinate) VertexElementDescription("TexCoord", VertexElementFormat.Float2, VertexElementSemantic.TextureCoordinate) |]) [] type PositionTextureColorVertex = { Position : Vector3 TexCoord : Vector2 Color : RgbaFloat } with interface IVertex with member _.Layout = VertexLayoutDescription([| VertexElementDescription("Position", VertexElementFormat.Float3, VertexElementSemantic.TextureCoordinate) VertexElementDescription("TexCoord", VertexElementFormat.Float2, VertexElementSemantic.TextureCoordinate) VertexElementDescription("Color", VertexElementFormat.Float4, VertexElementSemantic.TextureCoordinate) |]) [] type PositionTextureDualColorVertex = { Position : Vector3 TexCoord : Vector2 Foreground : RgbaFloat Background : RgbaFloat } with interface IVertex with member _.Layout = VertexLayoutDescription([| VertexElementDescription("Position", VertexElementFormat.Float3, VertexElementSemantic.TextureCoordinate) VertexElementDescription("TexCoord", VertexElementFormat.Float2, VertexElementSemantic.TextureCoordinate) VertexElementDescription("Foreground", VertexElementFormat.Float4, VertexElementSemantic.TextureCoordinate) VertexElementDescription("Background", VertexElementFormat.Float4, VertexElementSemantic.TextureCoordinate) |]) [] type internal ReadOnlyArray4<'a> = { Value0 : 'a Value1 : 'a Value2 : 'a Value3 : 'a } with member c.Item with get i = match i with | 0 -> c.Value0 | 1 -> c.Value1 | 2 -> c.Value2 | 3 -> c.Value3 | _ -> failwith $"Index out of range ({i})" static member Create(v0, v1, v2, v3) = { Value0 = v0 Value1 = v1 Value2 = v2 Value3 = v3 } [] type ColorTextureSprite = { Center : Vector2 Size : Vector2 Rotation : Vector2 TexBounds : Range2 Color : RgbaFloat } with static member Default = { Center = Vector2.Zero Size = Vector2.One Rotation = Vector2.UnitX TexBounds = Range2.ZeroToOne Color = RgbaFloat.White } [] type VertexSpanExtensions = [] static member GetTriangleSpan<'a>(w : IBufferWriter<'a>, spriteCount) = let vertexCount = spriteCount * 3 w.GetSpan(vertexCount).Slice(0, vertexCount) [] static member GetQuadSpan<'a>(w : IBufferWriter<'a>, spriteCount) = let vertexCount = spriteCount * 4 w.GetSpan(vertexCount).Slice(0, vertexCount) // Vector2 triangles [] static member DrawTriangle(span : Span, p0 : Vector2, p1 : Vector2, p2 : Vector2) = span.[0] <- p0 span.[1] <- p1 span.[2] <- p2 [] static member DrawTriangle(w : IBufferWriter, p0 : Vector2, p1 : Vector2, p2 : Vector2) = let span = w.GetTriangleSpan(1) span.DrawTriangle(p0, p1, p2) w.Advance(span.Length) // Vector2 quads [] static member DrawQuad(span : Span, rect : Range2) = span.[0] <- Vector2(rect.Min.X, rect.Min.Y) span.[1] <- Vector2(rect.Max.X, rect.Min.Y) span.[2] <- Vector2(rect.Max.X, rect.Max.Y) span.[3] <- Vector2(rect.Min.X, rect.Max.Y) [] static member DrawQuad(w : IBufferWriter, rect : Range2) = let span = w.GetQuadSpan(1) span.DrawQuad(rect) w.Advance(span.Length) // PositionColorVertex triangles [] static member DrawTriangle(span : Span, p0 : Vector2, p1 : Vector2, p2 : Vector2, color) = span.[0] <- { Position = Vector3(p0.X, p0.Y, 0.0f); Color = color } span.[1] <- { Position = Vector3(p1.X, p1.Y, 0.0f); Color = color } span.[2] <- { Position = Vector3(p2.X, p2.Y, 0.0f); Color = color } [] static member DrawTriangle(w : IBufferWriter, p0, p1, p2, color) = let span = w.GetTriangleSpan(1) span.DrawTriangle(p0, p1, p2, color) w.Advance(span.Length) // PositionColorVertex quads [] static member DrawQuad(span : Span, rect : Range2, color) = span.[0] <- { Position = Vector3(rect.Min.X, rect.Min.Y, 0.0f); Color = color } span.[1] <- { Position = Vector3(rect.Max.X, rect.Min.Y, 0.0f); Color = color } span.[2] <- { Position = Vector3(rect.Max.X, rect.Max.Y, 0.0f); Color = color } span.[3] <- { Position = Vector3(rect.Min.X, rect.Max.Y, 0.0f); Color = color } [] static member DrawQuad(w : IBufferWriter, rect : Range2, color) = let span = w.GetQuadSpan(1) span.DrawQuad(rect, color) w.Advance(span.Length) // PositionTextureColorVertex triangles [] static member DrawTriangle(span : Span, p0 : Vector2, p1 : Vector2, p2 : Vector2, tc0, tc1, tc2, color) = span.[0] <- { Position = Vector3(p0.X, p0.Y, 0.0f); TexCoord = tc0; Color = color } span.[1] <- { Position = Vector3(p1.X, p1.Y, 0.0f); TexCoord = tc1; Color = color } span.[2] <- { Position = Vector3(p2.X, p2.Y, 0.0f); TexCoord = tc2; Color = color } [] static member DrawTriangle(w : IBufferWriter, p0, p1, p2, tc0, tc1, tc2, color) = let span = w.GetTriangleSpan(1) span.DrawTriangle(p0, p1, p2, tc0, tc1, tc2, color) w.Advance(span.Length) // PositionTextureColorVertex quads [] static member DrawQuad(span : Span, rect : Range2, texBounds : Range2, color) = span.[0] <- { Position = Vector3(rect.Min.X, rect.Min.Y, 0.0f); TexCoord = Vector2(texBounds.X.Min, texBounds.Y.Min); Color = color } span.[1] <- { Position = Vector3(rect.Max.X, rect.Min.Y, 0.0f); TexCoord = Vector2(texBounds.X.Max, texBounds.Y.Min); Color = color } span.[2] <- { Position = Vector3(rect.Max.X, rect.Max.Y, 0.0f); TexCoord = Vector2(texBounds.X.Max, texBounds.Y.Max); Color = color } span.[3] <- { Position = Vector3(rect.Min.X, rect.Max.Y, 0.0f); TexCoord = Vector2(texBounds.X.Min, texBounds.Y.Max); Color = color } [] static member DrawQuad(span : Span, sprite : ColorTextureSprite) = let dxDir = sprite.Rotation let dyDir = dxDir.GetPerpendicular() let dx = dxDir * sprite.Size.X let dy = dyDir * sprite.Size.Y let p00 = sprite.Center - (dx + dy) * 0.5f let p10 = p00 + dx let p11 = p10 + dy let p01 = p11 - dx let t00 = sprite.TexBounds.Min let t11 = sprite.TexBounds.Max span.[0] <- { Position = Vector3(p00.X, p00.Y, 0.0f) TexCoord = Vector2(t00.X, t00.Y) Color = sprite.Color } span.[1] <- { Position = Vector3(p10.X, p10.Y, 0.0f) TexCoord = Vector2(t11.X, t00.Y) Color = sprite.Color } span.[2] <- { Position = Vector3(p11.X, p11.Y, 0.0f) TexCoord = Vector2(t11.X, t11.Y) Color = sprite.Color } span.[3] <- { Position = Vector3(p01.X, p01.Y, 0.0f) TexCoord = Vector2(t00.X, t11.Y) Color = sprite.Color } [] static member DrawQuad(w : IBufferWriter, rect : Range2, texBounds : Range2, color) = let span = w.GetQuadSpan(1) span.DrawQuad(rect, texBounds, color) w.Advance(span.Length) [] static member DrawQuad(w : IBufferWriter, sprite : ColorTextureSprite) = let span = w.GetQuadSpan(1) span.DrawQuad(sprite) w.Advance(span.Length) [] static member DrawNinePatchRect(w : IBufferWriter, rect : Range2i, atlasSize : Vector2i, texBounds : Range2i, margin0 : Vector2i, margin1 : Vector2i, color : RgbaFloat) = let m0 = margin0.ToVector2() let m1 = margin1.ToVector2() let p0 = rect.Min.ToVector2() let p3 = rect.Max.ToVector2() let tc0 = texBounds.Min.ToVector2() let tc3 = texBounds.Max.ToVector2() let px = ReadOnlyArray4<_>.Create(p0.X, p0.X + m0.X, p3.X - m1.X, p3.X) let py = ReadOnlyArray4<_>.Create(p0.Y, p0.Y + m0.Y, p3.Y - m1.Y, p3.Y) let tx = ReadOnlyArray4<_>.Create(tc0.X, tc0.X + m0.X, tc3.X - m1.X, tc3.X) let ty = ReadOnlyArray4<_>.Create(tc0.Y, tc0.Y + m0.Y, tc3.Y - m1.Y, tc3.Y) let atlasScale = Vector2.One / atlasSize.ToVector2() let span = w.GetQuadSpan(9) for y = 0 to 2 do for x = 0 to 2 do let t0 = Vector2(tx.[x], ty.[y]) * atlasScale let t1 = Vector2(tx.[x + 1], ty.[y + 1]) * atlasScale let p0 = Vector2(px.[x], py.[y]) let p1 = Vector2(px.[x + 1], py.[y + 1]) let i = y * 3 + x let span = span.Slice(i * 4) span.DrawQuad( Range2(p0, p1), Range2(t0, t1), color) w.Advance(span.Length) // PositionTextureDualColorVertex triangles [] static member DrawTriangle(span : Span, p0 : Vector2, p1 : Vector2, p2 : Vector2, tc0, tc1, tc2, fg, bg) = span.[0] <- { Position = Vector3(p0.X, p0.Y, 0.0f); TexCoord = tc0; Foreground = fg; Background = bg } span.[1] <- { Position = Vector3(p1.X, p1.Y, 0.0f); TexCoord = tc1; Foreground = fg; Background = bg } span.[2] <- { Position = Vector3(p2.X, p2.Y, 0.0f); TexCoord = tc2; Foreground = fg; Background = bg } [] static member DrawTriangle(w : IBufferWriter, p0, p1, p2, tc0, tc1, tc2, fg, bg) = let span = w.GetTriangleSpan(1) span.DrawTriangle(p0, p1, p2, tc0, tc1, tc2, fg, bg) w.Advance(span.Length) // PositionTextureDualColorVertex quads [] static member DrawQuad(span : Span, rect : Range2, texBounds : Range2, fg, bg) = span.[0] <- { Position = Vector3(rect.Min.X, rect.Min.Y, 0.0f); TexCoord = Vector2(texBounds.X.Min, texBounds.Y.Min); Foreground = fg; Background = bg } span.[1] <- { Position = Vector3(rect.Max.X, rect.Min.Y, 0.0f); TexCoord = Vector2(texBounds.X.Max, texBounds.Y.Min); Foreground = fg; Background = bg } span.[2] <- { Position = Vector3(rect.Max.X, rect.Max.Y, 0.0f); TexCoord = Vector2(texBounds.X.Max, texBounds.Y.Max); Foreground = fg; Background = bg } span.[3] <- { Position = Vector3(rect.Min.X, rect.Max.Y, 0.0f); TexCoord = Vector2(texBounds.X.Min, texBounds.Y.Max); Foreground = fg; Background = bg } [] static member DrawQuad(w : IBufferWriter, rect : Range2, texBounds : Range2, fg, bg) = let span = w.GetQuadSpan(1) span.DrawQuad(rect, texBounds, fg, bg) w.Advance(span.Length) ================================================ FILE: samples/Garnet.Toolkit/Window.fs ================================================ namespace Garnet.Graphics open System open System.IO open Veldrid open Veldrid.StartupUtilities open ImGuiNET open Garnet.Numerics open Garnet.Input type WindowSettings = { X : int Y : int Width : int Height : int Title : string Background : RgbaFloat Redraw : Redraw FullScreen : bool } with static member Default = { X = 100 Y = 100 Width = 640 Height = 360 Title = "Garnet" Background = RgbaFloat.Clear Redraw = Redraw.Auto FullScreen = false } module private Environment = let addPathVariables() = // Set path variable so native DLLs can be found when running in FSI let basePath = Path.GetDirectoryName(Directory.GetCurrentDirectory()) let nativePath = Path.Combine(basePath, @"runtimes\win-x64\native") let ev = Environment.GetEnvironmentVariable("Path") if not (ev.Contains(nativePath)) then Environment.SetEnvironmentVariable("Path", $"{ev};{nativePath}") type WindowRenderer(settings) = let window = Environment.addPathVariables() // Create window initially hidden until background can be drawn let windowCI = WindowCreateInfo( X = settings.X, Y = settings.Y, WindowWidth = settings.Width, WindowHeight = settings.Height, WindowInitialState = WindowState.Hidden, WindowTitle = settings.Title ) VeldridStartup.CreateWindow(windowCI) let device = let options = GraphicsDeviceOptions(false, Nullable(), false) VeldridStartup.CreateGraphicsDevice(window, options) let imGui = new ImGuiRenderer(device, device.MainSwapchain.Framebuffer.OutputDescription, window.Width, window.Height) let renderer = new Renderer(device, settings.Redraw) let mutable isDrawn = false member c.Title with get() = window.Title and set value = window.Title <- value member c.Position with get() = Vector2i(window.X, window.Y) and set(value : Vector2i) = window.X <- value.X window.Y <- value.Y member c.Size with get() = Vector2i(window.Width, window.Height) and set(value : Vector2i) = window.Width <- value.X window.Height <- value.Y member val Background = settings.Background with get, set member c.ImGui = imGui member c.Device = device member c.RenderContext = renderer.Context member c.IsShown = match window.WindowState with | WindowState.Hidden | WindowState.Minimized -> false | _ -> window.Visible member c.Invalidate() = renderer.Invalidate() member c.Close() = window.Close() member c.ToggleFullScreen() = window.WindowState <- match window.WindowState with | WindowState.BorderlessFullScreen -> WindowState.Normal | _ -> WindowState.BorderlessFullScreen member c.BeginDraw() = // Avoid drawing when we've drawn at least once but window isn't visible if isDrawn && not c.IsShown then false else // Proceed with drawing imGui.WindowResized(window.Width, window.Height) renderer.BeginDraw(window.Width, window.Height, c.Background) member c.EndDraw() = // Need to call this after beginning drawing but before ending. If we call // before any drawing, then there will be a brief white flicker as the window // is shown. If we call after all drawing, the initial render will not be // presented to the window, which is visible if doing manual redraw. if not window.Visible then if settings.FullScreen then window.WindowState <- WindowState.BorderlessFullScreen window.Visible <- true isDrawn <- true // Complete rendering imGui.Render(device, renderer.Context.Commands) renderer.EndDraw() member c.Update(deltaSeconds, inputs : InputCollection) = let snapshot = window.PumpEvents() if not window.Exists then false else imGui.Update(deltaSeconds, snapshot) inputs.ClearEvents() if not (ImGui.GetIO().WantCaptureKeyboard) then inputs.UpdateKeysFromSnapshot(snapshot) if not (ImGui.GetIO().WantCaptureMouse) then inputs.UpdateMouseFromSnapshot(snapshot, c.Size) true member c.Dispose() = renderer.Dispose() imGui.Dispose() device.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: samples/README.md ================================================ # Samples ## Flocking [[Code](Garnet.Samples.Flocking)] Boids-style flocking and clustering using Garnet ECS and Veldrid. ![Flocking](Garnet.Samples.Flocking/flocking-screenshot.png "Flocking") ## Trixel [[Code](Garnet.Samples.Trixel)] Trixel editor using Veldrid and Dear ImGUI. ![Trixel](Garnet.Samples.Trixel/trixel-screenshot.png "Trixel") ## Roguelike [[Code](Garnet.Samples.Roguelike)] Classic roguelike using Veldrid. Core logic and types are idiomatic F# with no ECS. FSI script allows for replay and testing. ![Roguelike](Garnet.Samples.Roguelike/roguelike-screenshot.png "Roguelike") ## Processor [[Code](Garnet.Processor)] This experimental utility is intended for asset processing. Currently it's just a packing utility for either assets or game files, using zip as the archive format. Garnet.Processor is available as a dotnet tool Nuget package [here](https://www.nuget.org/packages/Garnet.Processor/) or via the command: `dotnet tool install Garnet.Processor`. **Background:** Asset files (textures, sounds, etc) are often converted and packed into an archive when released with the game. Converting files to an optimal format for the target platform or hardware can make loading faster. Having a small number of packed asset files reduces the overhead of opening individual files and reduces wasted space on the file system. ## Numerics [[Code](Garnet.Numerics)] This experimental library has a variety of game-centric numerics or related code that isn't already covered by System.Numerics. It has no dependency on other Garnet libraries. Garnet.Numerics is available as a Nuget package [here](https://www.nuget.org/packages/Garnet.Numerics). ## Toolkit [[Code](Garnet.Toolkit)] Experimental shared code used by samples, including sprite drawing, particles, noise, audio playback, and more. Depends on [Veldrid](https://github.com/mellinoe/veldrid) for graphics, [OpenTK.OpenAL](https://opentk.net/) for audio, [ZLogger](https://github.com/Cysharp/ZLogger) for logging, and Garnet.Numerics. Garnet.Toolkit is available as a Nuget package [here](https://www.nuget.org/packages/Garnet.Toolkit). This library has two levels of integration: - Graphics/audio/etc: Wrapper or convenience methods over other libraries with no dependence on Garnet ECS - Composition: For use with Garnet ECS, the library includes predefined plugin-like systems for the various functionality ```fsharp static member AddDefaultSystems(c : Container) = Disposable.Create [ c.AddAssetsFolder() c.AddTextLoaders() c.AddGraphics() c.AddAudioDevice() c.AddAudioLoaders() c.AddTickUpdate() ] ``` The asset system in Garnet.Toolkit can load assets either from a folder (first choice) or from an asset archive file (if no folder is present). The folder option can be convenient for editing assets during development or for allowing modding. **Known issue:** Microsoft.CodeAnalysis.* assemblies may be included in build output, but they are not needed and add around 10 MB. They are included because Garnet.Toolkit depends on Veldrid, which depends on SharpDX, which depends on NETCore.App, which depends on the CodeAnalysis assemblies. Workaround: Use [Paket](https://github.com/fsprojects/Paket), which uninstalls transitive dependencies if no direct dependencies still depend on them. ================================================ FILE: src/Garnet/Actors.fs ================================================ namespace Garnet.Composition open System open System.Buffers open System.Diagnostics open System.Threading open System.Collections.Generic open System.Runtime.InteropServices /// Defines which kind of thread an actor can be executed on type DispatcherType = /// Actor which can be run on a background thread | Background = 0 /// Actor which must be run on the main thread | Foreground = 1 type DispatcherDescriptor = { DispatcherType : DispatcherType /// Optional, useful to see thread name when printing, debugging, or profiling. Name : string /// For background dispatchers, the number of worker threads ThreadCount : int /// Max number of batches to process for an actor before releasing lock. When /// the number of actors exceeds the number of workers, lower values increase /// fairness while higher values reduce overhead from locking and other worker /// queue operations. Throughput : int } with // Allow at least one background thread static member DefaultThreadCount = Environment.ProcessorCount - 1 |> max 1 /// Pool of background threads static member Background = { DispatcherType = DispatcherType.Background Name = "Background" ThreadCount = DispatcherDescriptor.DefaultThreadCount Throughput = 100 } /// Single foreground thread static member Foreground = { DispatcherType = DispatcherType.Foreground Name = "Foreground" ThreadCount = 0 Throughput = 100 } /// Single dedicated background thread static member Dedicated = { DispatcherType = DispatcherType.Background Name = "Dedicated" ThreadCount = 1 Throughput = 1000 } type ActorSystemConfiguration = { /// The last dispatcher in the list is used if an actor defines /// a dispatcher ID that does not exist Dispatchers : DispatcherDescriptor[] } with static member SingleThread = { Dispatchers = [| DispatcherDescriptor.Foreground |] } static member Create(workerCount) = if workerCount = 0 then ActorSystemConfiguration.SingleThread else { Dispatchers = [| { DispatcherDescriptor.Background with ThreadCount = workerCount } DispatcherDescriptor.Foreground |] } static member Default = ActorSystemConfiguration.Create(DispatcherDescriptor.DefaultThreadCount) type ActorException(sourceId : ActorId, destId : ActorId, msg : string, innerEx : Exception) = inherit Exception(msg, innerEx) member _.SourceId = sourceId member _.DestinationId = destId [] module internal Pooling = module TypeInfo = let mutable private count = 0 let next() = Interlocked.Increment(&count) - 1 type TypeInfo<'a>() = static let mutable id = TypeInfo.next() static member Id = id [] module internal Processing = [] type QueuedMessage = { Buffer : obj Count : int SourceId : ActorId DestinationId : ActorId Pool : obj } // Stateless type IDeliverer = abstract Deliver : IInbox * IOutbox * QueuedMessage -> unit // Stateless type Deliverer<'a>() = static let instance = Deliverer<'a>() :> IDeliverer static member Instance = instance interface IDeliverer with member c.Deliver(inbox, outbox, message) = let buffer = message.Buffer :?> 'a[] let pool = message.Pool :?> ArrayPool<'a> try try inbox.Receive(outbox, { Buffer = buffer Count = message.Count SourceId = message.SourceId DestinationId = message.DestinationId Pool = pool }) with | ex -> let msg = $"Processing failed:\n%A{buffer.[0]}" raise (exn(msg, ex)) finally pool.Return(buffer) // Thread-safe type IDispatcher = inherit IDisposable abstract Process : bool -> bool abstract Enqueue : ActorProcessor -> unit abstract OnException : ActorException -> unit abstract ToString : IStringBlockWriter -> unit // Thread-safe and ActorProcessor(actorId, inbox : IInbox, dispose, dispatcher : IDispatcher) = let processSync = obj() let queueSync = obj() let queue = Queue() let mutable inbox = inbox let mutable maxQueued = 0 let mutable total = 0 let mutable waitDuration = 0L let mutable waitCount = 0 // returns number of messages before processing let run outbox = // lock for duration of dequeue, which ends // in handler process method Monitor.Enter(queueSync) let remaining = queue.Count if remaining = 0 then Monitor.Exit queueSync else let struct(message, deliverer) = queue.Dequeue() Monitor.Exit(queueSync) try deliverer.Deliver(inbox, outbox, message) with | ex -> // Halt any further processing of actor inbox <- NullInbox.Instance // Report exception let msg = $"Actor %d{actorId} failed" let actorEx = ActorException(message.SourceId, message.DestinationId, msg, ex) dispatcher.OnException(actorEx) remaining member c.ActorId = actorId member c.WaitDuration = waitDuration member c.Enqueue<'a>(message : Message<'a>) = let queued : QueuedMessage = { SourceId = message.SourceId DestinationId = message.DestinationId Count = message.Count Buffer = message.Buffer Pool = message.Pool } let entry = struct(queued, Deliverer<'a>.Instance) Monitor.Enter(queueSync) queue.Enqueue(entry) // This check is an optimization to avoid queuing actors repeatedly in dispatchers, // but it relies on dispatchers taking full responsibility to ensure all messages // are handled. Otherwise, the actor will be orphaned and continue to accumulate // messages without a dispatcher to run it. let r = if queue.Count = 1 then ValueSome dispatcher else ValueNone maxQueued <- max maxQueued queue.Count Monitor.Exit queueSync r member private c.Process(outbox, throughput) = if not (Monitor.TryEnter processSync) then // This is a case where actor is in more than one dispatcher queue and // contention has occurred. This should only occur when a worker has // completed all messages and has already decided to release its lock // when another message is enqueued, causing a second worker to pick it // up and attempt to process it (before the first has released lock). let start = Stopwatch.GetTimestamp() Monitor.Enter processSync let stop = Stopwatch.GetTimestamp() waitDuration <- waitDuration + stop - start waitCount <- waitCount + 1 // using remaining count to avoid locking again // when throughput >1 let mutable remaining = 1 let original = total let target = total + throughput while total < target && remaining > 0 do // get count in queue prior to dequeuing remaining <- run outbox if remaining > 0 then // count the batch that was just processed total <- total + 1 remaining <- remaining - 1 let count = total - original Monitor.Exit processSync count /// Takes total byref to allow frequent updating in case this takes a long /// time to return. member c.ProcessAll(outbox, throughput, total : byref) = let mutable count = 0 let mutable pending = true while pending do let delta = c.Process(outbox, throughput) count <- count + delta total <- total + int64 delta pending <- delta > 0 count member c.Dispose() = lock processSync (fun () -> lock queueSync (fun () -> queue.Clear()) dispose() ) override c.ToString() = $"Actor %d{actorId}: %d{total} batches processed (%d{waitCount} waits, %d{waitDuration} ticks), %d{maxQueued} max queued" interface IDisposable with member c.Dispose() = c.Dispose() // Thread-safe type IDispatcherLookup = abstract GetDispatcher : int -> IDispatcher // Thread-safe type SharedActorMap(lookup : IDispatcherLookup) = let sync = obj() let dict = Dictionary() let actors = List() let factories = ActorFactoryCollection() member c.Count = actors.Count member c.Register(factory : IActorFactory) = Monitor.Enter sync factories.Add(factory) Monitor.Exit sync member c.GetProcessor(destId) = Monitor.Enter sync let r = match dict.TryGetValue(destId) with | true, x -> x | false, _ -> let actor = factories.Create(ActorId destId) let proc = new ActorProcessor(destId, actor.Inbox, actor.Dispose, lookup.GetDispatcher(actor.DispatcherId)) actors.Add(proc) dict.Add(destId, proc) proc Monitor.Exit sync r member c.Dispose() = lock sync <| fun () -> for proc in actors do proc.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() member c.ToString(writer : IStringBlockWriter) = lock sync <| fun () -> let count = min dict.Count 20 let ordered = dict.Values |> Seq.sortBy (fun a -> -a.WaitDuration, a.ActorId) |> Seq.take count if writer.BeginList("Actors", actors.Count) then for actor in ordered do writer.Write(actor.ToString()) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) [] module internal Dispatchers = // Thread-safe type DispatchQueue(owner : IDispatcher) = let mutable maxCount = 0 let queue = Queue() let signal = new ManualResetEventSlim(false) let sync = obj() member c.Wait() = signal.Wait() member c.GetCount() = Monitor.Enter(sync) let r = queue.Count Monitor.Exit(sync) r member c.Enqueue(x) = Monitor.Enter(sync) queue.Enqueue(x) maxCount <- max queue.Count maxCount if queue.Count = 1 then signal.Set() Monitor.Exit(sync) member c.TryDequeue([] item : byref<_>) = Monitor.Enter(sync) let r = queue.Count > 0 // note we don't reset when queue is empty, which can be when disposing let canReset = queue.Count = 1 if r then item <- queue.Dequeue() if canReset then signal.Reset() Monitor.Exit(sync) r member c.Enqueue(actor : ActorProcessor, message : Message<'a>) = match actor.Enqueue<'a>(message) with | ValueNone -> () | ValueSome dispatcher -> if obj.ReferenceEquals(dispatcher, owner) then c.Enqueue(actor) else dispatcher.Enqueue(actor) member c.Dispose() = Monitor.Enter(sync) queue.Clear() signal.Set() signal.Dispose() Monitor.Exit(sync) interface IDisposable with member c.Dispose() = c.Dispose() override c.ToString() = lock sync <| fun () -> $"%d{maxCount} actors max queued" // Not thread-safe type LocalOutbox(name, queue : DispatchQueue, actorMap : SharedActorMap) = let actors = Dictionary() member private c.Get(destId) = match actors.TryGetValue(destId) with | true, actor -> actor | false, _ -> let actor = actorMap.GetProcessor(destId) actors.Add(destId, actor) actor member val ActiveId = 0 with get, set member c.SendAll<'a>(message : Message<'a>, deliveryId : ActorId) = let processor = c.Get(deliveryId.Value) let message = if message.SourceId.Value = 0 then { message with SourceId = ActorId c.ActiveId } else message queue.Enqueue(processor, message) interface IOutbox with member c.SendAll<'a>(message, deliveryId) = c.SendAll<'a>(message, deliveryId) override c.ToString() = $"{name}: %d{actors.Count} outbox actors" // Thread-safe type SharedOutbox(actors : SharedActorMap) = member c.SendAll<'a>(message : Message<'a>, deliveryId : ActorId) = let actor = actors.GetProcessor(deliveryId.Value) match actor.Enqueue<'a>(message) with | ValueSome dispatcher -> dispatcher.Enqueue(actor) | ValueNone -> () interface IOutbox with member c.SendAll<'a>(message, deliveryId) = c.SendAll<'a>(message, deliveryId) [] type WorkerStatus = { QueuedCount : int ProcessedCount : int64 } module WorkerStatus = let empty = { QueuedCount = 0 ProcessedCount = 0L } let add a b = { QueuedCount = a.QueuedCount + b.QueuedCount ProcessedCount = a.ProcessedCount + b.ProcessedCount } let isRunning s1 s2 = s1.ProcessedCount <> s2.ProcessedCount || s2.QueuedCount > 0 // Thread-safe type private Worker(owner : IDispatcher, actorMap, name, workerId, throughput, workers : Worker[]) = let queue = new DispatchQueue(owner) let outbox = LocalOutbox(workerId.ToString(), queue, actorMap) let sync = obj() let mutable active = Unchecked.defaultof let mutable isRunning = true let mutable waits = 0 let mutable total = 0L let runStealing() = // Note we are stealing actors, not individual batches of messages. This way // we avoid situations where a actor that takes a long time to process spreads // across and blocks all workers. let mutable found = false if workers.Length > 1 then let mutable i = 0 while i < workers.Length && not found do if i <> workerId then found <- workers.[i].TryDequeue(&active) i <- i + 1 found let runDequeue() = queue.TryDequeue(&active) let runActive() = let mutable count = 0 if not (obj.ReferenceEquals(active, null)) then // run single actor until no messages remain, respecting // throughput param outbox.ActiveId <- active.ActorId count <- count + active.ProcessAll(outbox, throughput, &total) outbox.ActiveId <- 0 active <- Unchecked.defaultof<_> count > 0 let runAll() = runActive() || runDequeue() || runStealing() let run() = try while isRunning do Monitor.Enter(sync) while isRunning && runAll() do () Monitor.Exit(sync) queue.Wait() waits <- waits + 1 with ex -> printfn "Failed %s" <| ex.ToString() let thread = let t = Thread(run) t.Name <- $"{name} %d{workerId}" t member c.TryDequeue([] item : byref<_>) = queue.TryDequeue(&item) member c.Start() = thread.Start() member c.Dispose() = isRunning <- false queue.Dispose() thread.Join() member c.GetStatus() = Monitor.Enter sync let r = { QueuedCount = queue.GetCount() ProcessedCount = total } Monitor.Exit sync r member c.Enqueue(x : ActorProcessor) = queue.Enqueue(x) member c.ToString(writer : IStringBlockWriter) = let name = $"{thread.Name} (%d{total} batches processed, %d{waits} waits)" let id = thread.Name if writer.Begin(name, id) then writer.Write(outbox.ToString()) writer.Write(queue.ToString()) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) interface IDisposable with member c.Dispose() = c.Dispose() // Thread-safe type WorkerDispatcher(actorMap, name, workerCount, throughput, onException) as c = let workers = // round up to pow2 size so we can avoid modulus let size = Bits.getNextPow2 workerCount let arr = Array.zeroCreate size // create workers for i = 0 to workerCount - 1 do arr.[i] <- new Worker(c, actorMap, name, i, throughput, arr) // fill in remaining by distributing original workers for i = workerCount to arr.Length - 1 do arr.[i] <- arr.[i % workerCount] // start separately since all workers must be created first for i = 0 to workerCount - 1 do arr.[i].Start() arr let getStatus() = // get aggregate status of all workers let mutable status = WorkerStatus.empty for i = 0 to workerCount - 1 do status <- WorkerStatus.add status (workers.[i].GetStatus()) status interface IDispatcher with member c.Process(waitThreads) = // pow2 size to avoid modulus let spinPeriod = 128 let mutable count = 0 if waitThreads then // keep polling status to see if anything changed or // there are queued items outstanding let mutable s1 = getStatus() let mutable s2 = getStatus() while WorkerStatus.isRunning s1 s2 do s1 <- s2 s2 <- getStatus() count <- count + 1 // if we've polled a bunch of times in a row with // continued activity, sleep and then resume if count &&& (spinPeriod - 1) = 0 then Thread.Sleep(1) count > 0 member c.Enqueue(actor) = // Distribute according to actor ID. If ID is uniformly // distributed, this is round-robin. Even if distribution is // not uniform, expect other workers to steal as needed. Note // worker array is a pow2 size. // For waiting/polling, we could just always add to the first // worker queue and rely on stealing, so this is really more // for use of signals instead of wait polling. let index = actor.ActorId &&& (workers.Length - 1) workers.[index].Enqueue(actor) member c.OnException(ex) = onException ex member c.Dispose() = for i = 0 to workerCount - 1 do workers.[i].Dispose() member c.ToString(writer) = c.ToString(writer) member c.ToString(writer : IStringBlockWriter) = if writer.BeginList("Workers", workerCount) then for i = 0 to workerCount - 1 do workers.[i].ToString(writer) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) // Thread-safe type Dispatcher(actorMap, name, throughput) as c = let queue = new DispatchQueue(c) let outbox = LocalOutbox(name, queue, actorMap) let sync = obj() let mutable total = 0L interface IDispatcher with member c.Process _ = // Process on current thread until queue is empty Monitor.Enter sync let mutable actor = Unchecked.defaultof<_> let mutable count = 0 while queue.TryDequeue &actor do outbox.ActiveId <- actor.ActorId count <- count + actor.ProcessAll(outbox, throughput, &total) outbox.ActiveId <- 0 Monitor.Exit sync count > 0 member c.Enqueue(actor) = queue.Enqueue actor member c.OnException(ex) = raise ex member c.Dispose() = queue.Dispose() member c.ToString(writer) = c.ToString(writer) member c.ToString(writer : IStringBlockWriter) = let name = $"{name} (%d{total} processed)" let id = name if writer.Begin(name, id) then writer.Write(outbox.ToString()) writer.Write(queue.ToString()) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) // Thread-safe type CurrentDispatcher(actorMap, name, throughput) = let outbox = SharedOutbox(actorMap) let sync = obj() let mutable total = 0L interface IDispatcher with member c.Process _ = false member c.Enqueue(actor) = Monitor.Enter sync actor.ProcessAll(outbox, throughput, &total) |> ignore Monitor.Exit sync member c.OnException(ex) = raise ex member c.Dispose() = () member c.ToString(writer) = c.ToString(writer) member c.ToString(writer : IStringBlockWriter) = let name = $"{name} (%d{total} processed)" let id = name if writer.Begin(name, id) then writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) /// Thread-safe if dispatchers do not change type DispatcherLookup(dispatcherCount) = let lookup = Array.zeroCreate dispatcherCount let runOnce waitThreads = // go once through dispatchers, waiting until // they individually have no work remaining, then // return whether work was done let mutable pending = false for d in lookup do pending <- d.Process(waitThreads) || pending pending member c.SetDispatcher(dispatcherId, dispatcher) = lookup.[dispatcherId] <- dispatcher member c.GetDispatcher(dispatcherId) = // assume last entry is the fallback let index = min dispatcherId (lookup.Length - 1) lookup.[index] interface IDispatcherLookup with member c.GetDispatcher execution = c.GetDispatcher execution member c.Process(waitThreads) = // keep running until no additional work is done // any blocking should be done at lower level like worker let mutable s1 = runOnce(waitThreads) let mutable s2 = runOnce(waitThreads) while s1 || s2 do s1 <- s2 s2 <- runOnce(waitThreads) /// Runs until all foreground work is done member c.Process() = c.Process(false) /// Sleep/poll while background threads complete member c.ProcessAll() = c.Process(true) member c.Dispose() = for d in lookup do d.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() member c.ToString(writer : IStringBlockWriter) = if writer.BeginList("Dispatchers", lookup.Length) then for dispatcher in lookup do dispatcher.ToString(writer) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) type DispatcherLookup with member c.SetDispatchers(actors, onWorkerError, dispatchers : _[]) = for i = 0 to dispatchers.Length - 1 do let desc = dispatchers.[i] let dispatcher : IDispatcher = match desc.DispatcherType with | DispatcherType.Foreground -> new Dispatcher(actors, desc.Name, desc.Throughput) :> IDispatcher | DispatcherType.Background | _ -> if desc.ThreadCount <= 0 then new Dispatcher(actors, desc.Name, desc.Throughput) :> IDispatcher else new WorkerDispatcher(actors, desc.Name, desc.ThreadCount, desc.Throughput, onWorkerError) :> IDispatcher c.SetDispatcher(i, dispatcher) type IMessagePump = inherit IOutbox inherit IDisposable abstract member Process : unit -> unit abstract member ProcessAll : unit -> unit type internal ExceptionHandlers() = let handlers = List>() let sync = obj() member private c.Remove(handler) = lock sync (fun () -> handlers.Remove(handler) |> ignore) member c.Handle(ex) = lock sync (fun () -> for handler in handlers do handler.Invoke(ex)) member c.Add(handler) = lock sync (fun () -> handlers.Add(handler)) new Disposable(fun () -> c.Remove(handler)) :> IDisposable // Thread-safe type ActorSystem(config) = let dispatchers = new DispatcherLookup(config.Dispatchers.Length) let actors = new SharedActorMap(dispatchers) let outbox = SharedOutbox(actors) let handlers = ExceptionHandlers() do dispatchers.SetDispatchers(actors, handlers.Handle, config.Dispatchers) new() = new ActorSystem(ActorSystemConfiguration.Default) new(workerCount) = new ActorSystem(ActorSystemConfiguration.Create(workerCount)) member c.ActorCount = actors.Count member c.Register(factory : IActorFactory) = actors.Register(factory) member c.RegisterExceptionHandler(onException) = handlers.Add(onException) member c.Dispose() = dispatchers.Dispose() actors.Dispose() /// Runs until all foreground work is done member c.Process() = dispatchers.Process() /// Sleep/poll while background threads complete member c.ProcessAll() = dispatchers.ProcessAll() member c.SendAll<'a>(message, deliveryId) = outbox.SendAll<'a>(message, deliveryId) interface IMessagePump with member c.SendAll<'a>(message, deliveryId) = c.SendAll<'a>(message, deliveryId) member c.Process() = c.Process() member c.ProcessAll() = c.ProcessAll() member c.Dispose() = c.Dispose() member c.ToString(writer : IStringBlockWriter) = actors.ToString(writer) dispatchers.ToString(writer) override c.ToString() = $"Actor system\n %s{Format.addIndent (actors.ToString())}%s{Format.addIndent (dispatchers.ToString())}" static member CreateSingleThread() = new ActorSystem(ActorSystemConfiguration.SingleThread) type NullMessagePump() = static let mutable instance = new NullMessagePump() :> IMessagePump static member Instance = instance interface IMessagePump with member c.SendAll<'a>(message, deliveryId) = NullOutbox.Instance.SendAll<'a>(message, deliveryId) member c.Process() = () member c.ProcessAll() = () member c.Dispose() = () [] type ActorReference = { ActorId : ActorId MessagePump : IMessagePump } with override c.ToString() = c.ActorId.ToString() static member Null = { ActorId = ActorId.Undefined MessagePump = NullMessagePump.Instance } [] module ActorSystem = type IMessagePump with member c.Get id = { ActorId = id MessagePump = c } member c.Process<'a>(destId, msg : 'a) = c.Send(destId, msg) c.Process() member c.Process<'a>(destId, sourceId, msg : 'a) = c.Send(destId, sourceId, msg) c.Process() type ActorSystem with member c.Register(factories : IActorFactory seq) = for f in factories do c.Register(f) member c.Register(tryCreate : ActorId -> Actor voption) = c.Register(ActorFactory.Create(tryCreate)) /// Creates for any actor ID member c.Register(create : ActorId -> Actor) = c.Register(ActorFactory.Create(create)) /// Creates conditionally for actor ID member c.Register(predicate : ActorId -> bool, create : ActorId -> Actor) = c.Register(ActorFactory.Create(predicate, create)) /// Creates for a specific actor ID member c.Register(actorId : ActorId, create : ActorId -> Actor) = c.Register(ActorFactory.Create(actorId, create)) /// Extensions for Container type ActorSystem with /// Creates conditionally for actor ID member c.Register(predicate, dispatcherId, register : Container -> IDisposable) = let create createId = let inbox = new LazyContainerInbox(createId, register) Actor(inbox, dispatcherId, inbox.Dispose) c.Register(predicate, create) member c.Register(predicate, register : Container -> IDisposable) = c.Register(predicate, 0, register) /// Creates for any actor ID member c.Register(dispatcherId, register : Container -> IDisposable) = let predicate (_ : ActorId) = true c.Register(predicate, dispatcherId, register) member c.Register(register : Container -> IDisposable) = c.Register(0, register) /// Creates for a specific actor ID member c.Register(actorId : ActorId, dispatcherId, register : Container -> IDisposable) = c.Register((=)actorId, dispatcherId, register) member c.Register(actorId : ActorId, register : Container -> IDisposable) = c.Register(actorId, 0, register) type ActorReference with member c.Send(msg) = c.MessagePump.Send(c.ActorId, msg) member c.Send(msg, sourceId) = c.MessagePump.Send(c.ActorId, sourceId, msg) member c.SendAll(span) = c.MessagePump.SendAll(c.ActorId, span) member c.SendAll<'a>(sourceId, span : ReadOnlySpan<'a>) = c.MessagePump.SendAll(c.ActorId, sourceId, span) member c.Process msg = c.MessagePump.Process(c.ActorId, msg) ================================================ FILE: src/Garnet/Channels.fs ================================================ namespace Garnet.Composition open System open System.Buffers open System.Collections.Generic open System.Diagnostics open System.Text open Garnet.Composition.Comparisons type internal EventHandler<'a> = ReadOnlyMemory<'a> -> unit type IPublisher = abstract member PublishAll<'a> : ReadOnlyMemory<'a> * ReadOnlyMemory> -> unit type internal IChannel = abstract member Clear : unit -> unit abstract member Commit : unit -> unit abstract member Publish : unit -> bool abstract member SetPublisher : IPublisher voption -> unit module internal Publisher = let formatBatch (messages : ReadOnlySpan<_>) = let sb = StringBuilder() let count = min 20 messages.Length for i = 0 to count - 1 do let msg = messages.[i] sb.AppendLine().Append(sprintf "%A" msg) |> ignore let remaining = messages.Length - count if remaining > 0 then sb.AppendLine().Append(sprintf "(+%d)" remaining) |> ignore sb.ToString() let publishAll<'a>(batch : ReadOnlyMemory<'a>) (handlers : ReadOnlySpan<_>) = for i = 0 to handlers.Length - 1 do let handler = handlers.[i] try handler batch with | ex -> let str = sprintf "Error in handler %d on %s batch (%d):%s" i (typeof<'a> |> Format.typeToString) batch.Length (formatBatch batch.Span) exn(str, ex) |> raise type Channel<'a>() = let unsubscribed = List>() let handlers = ResizableBuffer>(8) let stack = ResizableBuffer<'a>(8) let mutable publisher : IPublisher voption = ValueNone let mutable events = ResizableBuffer<'a>(8) let mutable pending = ResizableBuffer<'a>(8) let mutable total = 0 member c.Clear() = stack.Clear() pending.Clear() member c.SetPublisher(newPublisher) = publisher <- newPublisher member c.PublishAll(batch : ReadOnlyMemory<'a>) = match publisher with | ValueNone -> Publisher.publishAll batch handlers.WrittenSpan | ValueSome publisher -> publisher.PublishAll(batch, handlers.WrittenMemory) /// Dispatches event immediately/synchronously member c.Publish(event) = stack.WriteValue(event) try let mem = stack.WrittenMemory.Slice(stack.WrittenCount - 1, 1) c.PublishAll(mem) finally stack.RemoveLast() member c.Send(event) = pending.WriteValue(event) total <- total + 1 member c.SendAll(events : ReadOnlyMemory<_>) = pending.Write(events.Span) total <- total + events.Length member c.Advance(count) = pending.Advance(count) total <- total + count member c.GetMemory(sizeHint) = pending.GetMemory(sizeHint) member c.GetSpan(sizeHint) = pending.GetSpan(sizeHint) interface IBufferWriter<'a> with member c.Advance(count) = c.Advance(count) member c.GetMemory(sizeHint) = c.GetMemory(sizeHint) member c.GetSpan(sizeHint) = c.GetSpan(sizeHint) member c.OnAll(handler : EventHandler<_>) = handlers.WriteValue(handler) Disposable.Create(fun () -> unsubscribed.Add(handler)) /// Calls handler behaviors and prunes subscriptions after member c.Publish() = if events.WrittenCount = 0 then false else c.PublishAll(events.WrittenMemory) true /// Commit pending events to publish list and resets member c.Commit() = if unsubscribed.Count > 0 then let mutable i = 0 while i < handlers.WrittenCount do // only remove one occurrence if unsubscribed.Remove handlers.[i] then // note ordering changes, but subscribers of the same // event type should not have any ordering dependencies handlers.[i] <- handlers.[handlers.WrittenCount - 1] handlers.RemoveLast() else i <- i + 1 unsubscribed.Clear() // clear prior events and swap in pending to current events.Clear() if pending.WrittenCount > 0 then let temp = pending pending <- events events <- temp interface IChannel with member c.Clear() = c.Clear() member c.Publish() = c.Publish() member c.Commit() = c.Commit() member c.SetPublisher(p) = c.SetPublisher(p) override c.ToString() = sprintf "%s: %dH %dP %dE %dT %dSE" (typeof<'a> |> Format.typeToString) handlers.WrittenCount pending.WrittenCount events.WrittenCount total stack.WrittenCount type IChannels = abstract member GetChannel<'a> : unit -> Channel<'a> /// Supports reentrancy type Channels() = let channels = List() let mutable lookup = Array.zeroCreate(8) let mutable publisher : IPublisher voption = ValueNone member c.Count = channels.Count member c.Clear() = for channel in channels do channel.Clear() member c.Commit() = for channel in channels do channel.Commit() member c.SetPublisher(newPublisher) = publisher <- newPublisher for channel in channels do channel.SetPublisher newPublisher /// Returns true if any events were handled member c.Publish() = // to handle reentrancy, avoid foreach and iterate up to current count let mutable published = false let count = channels.Count for i = 0 to count - 1 do published <- channels.[i].Publish() || published published member c.GetChannel<'a>() = let id = MessageTypeId<'a>.Id if id >= lookup.Length then Buffer.resizeArray (id + 1) &lookup let channel = lookup.[id] if isNotNull channel then channel :?> Channel<'a> else let channel = Channel<'a>() channel.SetPublisher publisher lookup.[id] <- channel :> IChannel channels.Add(channel) channel interface IChannels with member c.GetChannel<'a>() = c.GetChannel<'a>() override c.ToString() = let sb = StringBuilder() sb.Append("Channels") |> ignore let groups = channels |> Seq.map (fun ch -> ch.GetType().GetGenericArguments().[0], ch) |> Seq.groupBy (fun (t, _) -> t.Namespace) |> Seq.sortBy (fun (key, _) -> key) for ns, group in groups do let name = if String.IsNullOrEmpty(ns) then "[None]" else ns sb.AppendLine().Append(" " + name) |> ignore let channels = group |> Seq.sortBy (fun (t, _) -> t.Name) |> Seq.map snd for channel in channels do sb.AppendLine().Append(" " + channel.ToString()) |> ignore sb.ToString() [] module Channels = type IChannels with member c.GetSender<'a>() = c.GetChannel<'a>().Send member c.Send(msg) = c.GetChannel<'a>().Send(msg) member c.OnAll<'a> handler = c.GetChannel<'a>().OnAll(handler) member c.Publish<'a>(event : 'a) = c.GetChannel<'a>().Publish(event) member c.OnAll<'a>() = c.GetChannel<'a>().OnAll member c.On<'a> handle = c.GetChannel<'a>().OnAll( fun batch -> let span = batch.Span for i = 0 to span.Length - 1 do handle span.[i]) /// Buffers incoming events in a second set of channels and subscribes /// handler to the buffered channel. THis is useful for holding events /// until a commit event is received or an appropriate update event occurs. member c.BufferOnAll<'a>(buffer : IChannels, handler) = let channel = buffer.GetChannel<'a>() Disposable.Create [ // when first channels receive events, write to buffer // events will need to be published by a separate mechanism c.OnAll<'a> channel.SendAll // subscribe handler to buffer rather than original channels channel.OnAll(handler) ] /// Buffers incoming events in a second set of channels and subscribes /// handler to the buffered channel. THis is useful for holding events /// until a commit event is received or an appropriate update event occurs. member c.BufferOn<'a>(buffer : IChannels, handle) = c.BufferOnAll<'a>(buffer, fun mem -> for e in mem.Span do handle e) type Channel<'a> with member c.Wait(msg) = c.Send(msg) Wait.All type IChannels with member c.Wait(msg) = c.GetChannel<'a>().Wait(msg) type internal NullPublisher() = static let mutable instance = NullPublisher() :> IPublisher static member Instance = instance interface IPublisher with member c.PublishAll(_, _) = () /// Single recorded timing consisting of N operations in a window of time. [] type Timing = { Name : string Start : int64 Stop : int64 Count : int } with member t.Duration = t.Stop - t.Start override t.ToString() = sprintf "%A, %A to %A (%A), %A ops" t.Name t.Start t.Stop t.Duration t.Count type PrintPublisherOptions = { EnableLog : bool LogLabel : string MessageSizeLimit : int MinDurationMicroseconds : int SendLog : string -> unit SendTiming : Timing -> unit CanSendLog : Type -> bool CanSendTiming : Type -> bool BasePublisher : IPublisher Formatter : IFormatter } /// Prints published events type internal PrintPublisher(options) = let sb = StringBuilder() let mutable count = 0 interface IPublisher with member c.PublishAll<'a>(batch : ReadOnlyMemory<'a>, handlers) = let start = Stopwatch.GetTimestamp() let mutable completed = false try options.BasePublisher.PublishAll(batch, handlers) completed <- true finally let typeInfo = Format.CachedTypeInfo<'a>.Info let canLog = options.EnableLog && options.CanSendLog typeof<'a> && options.Formatter.CanFormat<'a>() let canTime = options.CanSendTiming typeof<'a> // stop timer let stop = Stopwatch.GetTimestamp() // send timing if canTime then options.SendTiming { Name = typeInfo.typeName Start = start Stop = stop Count = batch.Length } // send log message if canLog then let duration = stop - start let usec = duration * 1000L * 1000L / Stopwatch.Frequency |> int if not completed || usec >= options.MinDurationMicroseconds then sb.Append( sprintf "[%s] %d: %dx %s to %d handlers in %dus%s" options.LogLabel count batch.Length (typeof<'a> |> Format.typeToString) handlers.Length usec (if completed then "" else " failed") ) |> ignore // print messages if not typeInfo.isEmpty then Format.formatMessagesTo sb options.Formatter.Format batch.Span options.MessageSizeLimit sb.AppendLine() |> ignore options.SendLog (sb.ToString()) sb.Clear() |> ignore count <- count + 1 type Publisher() = static let mutable instance = Publisher() :> IPublisher static member Default = instance static member Null = NullPublisher.Instance static member Print options = PrintPublisher(options) :> IPublisher interface IPublisher with member c.PublishAll<'a>(batch : ReadOnlyMemory<'a>, handlers : ReadOnlyMemory<_>) = Publisher.publishAll batch handlers.Span module PrintPublisherOptions = let enabled = { EnableLog = true LogLabel = "" MessageSizeLimit = 10 MinDurationMicroseconds = 0 SendLog = printfn "%s" SendTiming = ignore CanSendLog = fun _ -> true CanSendTiming = fun _ -> true BasePublisher = Publisher.Default Formatter = Formatter() } ================================================ FILE: src/Garnet/Collections.fs ================================================ namespace Garnet.Composition open System open System.Collections open System.Collections.Generic open System.Runtime.InteropServices open Garnet.Composition.Comparisons open System.Buffers module internal Bits = let inline bitCount x = let x = x - ((x >>> 1) &&& 0x55555555) let x = (x &&& 0x33333333) + ((x >>> 2) &&& 0x33333333) (((x + (x >>> 4)) &&& 0x0F0F0F0F) * 0x01010101) >>> 24 let inline bitCount64 (x : uint64) = bitCount (int (x >>> 32)) + bitCount (int (x &&& 0xffffffffUL)) let bitCount64Array (arr : uint64[]) = let mutable total = 0 for x in arr do total <- total + bitCount64 x total let inline getNextPow2 x = let mutable y = x - 1 y <- y ||| (y >>> 1) y <- y ||| (y >>> 2) y <- y ||| (y >>> 4) y <- y ||| (y >>> 8) y <- y ||| (y >>> 16) y <- y + 1 if y > 0 then y else 1 module internal Buffer = let expandArray required (arr : _[]) = let newArr = Array.zeroCreate (Bits.getNextPow2 required) arr.CopyTo(newArr, 0) newArr let resizeArray count (arr : byref<_[]>) = if count > arr.Length then arr <- expandArray count arr let addToArray (count : byref) (arr : byref<_[]>) x = count <- count + 1 resizeArray count &arr arr.[count - 1] <- x let addAllToArray (count : byref) (arr : byref<_[]>) (src : ReadOnlySpan<_>) = let destOffset = count count <- count + src.Length resizeArray count &arr let dest = Span(arr, destOffset, src.Length) src.CopyTo(dest) let copyArrayMask mask (src : _[]) (dest : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then dest.[i] <- src.[i] m <- m >>> 1 i <- i + 1 let clearArray (arr : _[]) = Array.Clear(arr, 0, arr.Length) let clearArrayMask mask (arr : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then arr.[i] <- Unchecked.defaultof<_> m <- m >>> 1 i <- i + 1 let getArrayBitCount64 (masks : uint64[]) count = let mutable total = 0 for i = 0 to count - 1 do total <- total + Bits.bitCount64 masks.[i] total /// Similar to ArrayBufferWriter, but provides additional read/write access to /// the underlying array. type internal ResizableBuffer<'a>(capacity) = let mutable buffer = Array.zeroCreate<'a> capacity let mutable pos = 0 member c.Item with get i = buffer.[i] and set i x = buffer.[i] <- x member c.WrittenCount = pos member c.WrittenSpan = ReadOnlySpan(buffer, 0, pos) member c.WrittenMemory = ReadOnlyMemory(buffer, 0, pos) member c.GetMemory(count) = // note min allocation in case count is zero let required = pos + max count 8 Buffer.resizeArray required &buffer buffer.AsMemory().Slice(pos) member c.GetSpan(count) = c.GetMemory(count).Span member c.Advance(count) = if count < 0 then failwithf "Cannot advance a negative value: %d" count pos <- pos + count member c.WriteValue(value) = if pos >= buffer.Length then Buffer.resizeArray (pos + 1) &buffer buffer.[pos] <- value pos <- pos + 1 member c.RemoveLast() = pos <- pos - 1 member c.Clear() = Array.Clear(buffer, 0, pos) pos <- 0 interface IBufferWriter<'a> with member c.GetSpan(count) = c.GetSpan(count) member c.GetMemory(count) = c.GetMemory(count) member c.Advance(count) = c.Advance(count) /// Mutable min-heap type internal Heap<'k, 'a when 'k :> IComparable<'k>>() = // create a dummy value for easier indexing let items = List>() do items.Add(Unchecked.defaultof<_>) let compare a b = items.[a].Key.CompareTo(items.[b].Key) let swap a b = let temp = items.[b] items.[b] <- items.[a] items.[a] <- temp let getMinChildIndex parentIndex = let ci = parentIndex * 2 if ci >= items.Count then -1 else // if we have a second child that's smaller, pick it // we know that if second exists, first exists due to shape let offset = if ci + 1 < items.Count && compare (ci + 1) ci < 0 then 1 else 0 ci + offset let rec siftDown index = // start at top and swap down through min child let ci = getMinChildIndex index if ci >= 0 && compare index ci > 0 then swap index ci siftDown ci let rec siftUp index = // start at end and swap up through parent // maintain parent/child invariant at each iteration if index > 1 && compare index (index / 2) < 0 then swap index (index / 2) siftUp (index / 2) member h.Items = items member h.Count = items.Count - 1 member h.Top = items.[1] member h.Insert(key, value) = items.Add(KeyValuePair(key, value)) siftUp (items.Count - 1) member h.RemoveMin() = if h.Count = 0 then failwith "Heap is empty" let top = h.Top items.[1] <- items.[items.Count - 1] items.RemoveAt(items.Count - 1) siftDown 1 top member h.Clear() = while items.Count > 1 do items.RemoveAt(items.Count - 1) /// Mutable, min queue (min priority value dequeued first) type PriorityQueue<'k, 'a when 'k :> IComparable<'k>>() = let heap = Heap<'k, 'a>() member q.Items = heap.Items member q.Count = heap.Count member q.Top = heap.Top member q.Enqueue(priority, value) = heap.Insert(priority, value) member q.Dequeue() = heap.RemoveMin().Value member q.Clear() = heap.Clear() [] module internal DictionarySlim = [] type Entry<'TKey, 'TValue when 'TKey :> IEquatable<'TKey> and 'TKey : equality> = { mutable key : 'TKey mutable value : 'TValue mutable next : int } let sizeOneIntArray = Array.zeroCreate 1 let inline eq<'a when 'a :> System.IEquatable<'a>> (x:'a) (y:'a) = x.Equals y let inline hash x mask = let h = x.GetHashCode() h &&& mask // Adapted from: // https://github.com/dotnet/corefxlab/blob/master/src/Microsoft.Experimental.Collections/Microsoft/Collections/Extensions/DictionarySlim.cs type internal DictionarySlim<'TKey, 'TValue when 'TKey :> IEquatable<'TKey> and 'TKey : equality>(capacity) = let mutable _count = 0 let mutable _freeList = -1 let mutable _buckets = Array.zeroCreate (max 2 capacity) let mutable _entries = Array.zeroCreate> (max 2 capacity) new() = DictionarySlim(2) member internal c.Entries = _entries member c.Count = _count member c.Clear() = _count <- 0 _freeList <- -1 // changed from original: keeping buffers to avoid GC Array.Clear(_buckets, 0, _buckets.Length) Array.Clear(_entries, 0, _entries.Length) member c.TryGetValue(key : 'TKey, [] value : byref<'TValue>) = let entries = _entries let mutable result = false let mutable i = _buckets.[hash key (_buckets.Length - 1)] - 1 value <- Unchecked.defaultof<'TValue> while uint32 i < uint32 entries.Length && not result do if eq key entries.[i].key then value <- entries.[i].value result <- true i <- entries.[i].next result member c.Contains(key) = let entries = _entries let mutable result = false let mutable i = _buckets.[hash key (_buckets.Length - 1)] - 1 while uint32 i < uint32 entries.Length && not result do if eq key entries.[i].key then result <- true i <- entries.[i].next result member c.Remove(key : 'TKey) = let entries = _entries let bucketIndex = hash key (_buckets.Length - 1) let mutable entryIndex = _buckets.[bucketIndex] - 1 let mutable lastIndex = -1 let mutable result = false while entryIndex <> -1 && not result do let candidate = entries.[entryIndex] if eq candidate.key key then if lastIndex <> -1 then // Fixup preceding element in chain to point to next (if any) entries.[lastIndex].next <- candidate.next else // Fixup bucket to new head (if any) _buckets.[bucketIndex] <- candidate.next + 1 entries.[entryIndex] <- Unchecked.defaultof<_> entries.[entryIndex].next <- -3 - _freeList // New head of free list _freeList <- entryIndex _count <- _count - 1 result <- true lastIndex <- entryIndex entryIndex <- candidate.next result member c.GetOrAddValueRef(key : inref<'TKey>) : byref<'TValue> = let entries = _entries let mutable bucketIndex = hash key (_buckets.Length - 1) let mutable i = _buckets.[bucketIndex] - 1 let mutable resultIndex = -1 while uint32 i < uint32 entries.Length && resultIndex < 0 do if eq key entries.[i].key then resultIndex <- i i <- entries.[i].next if resultIndex >= 0 then &entries.[resultIndex].value else // AddKey() let mutable entries = _entries let entryIndex = if _freeList <> -1 then let entryIndex = _freeList _freeList <- -3 - entries.[_freeList].next entryIndex else if _count = entries.Length || entries.Length = 1 then entries <- c.Resize() bucketIndex <- hash key (_buckets.Length - 1) // entry indexes were not changed by Resize _count entries.[entryIndex].key <- key entries.[entryIndex].next <- _buckets.[bucketIndex] - 1 _buckets.[bucketIndex] <- entryIndex + 1 _count <- _count + 1 &entries.[entryIndex].value member private c.Resize() = let mutable count = _count let newSize = _entries.Length * 2 let entries = Array.zeroCreate> newSize Array.Copy(_entries, 0, entries, 0, count) let newBuckets = Array.zeroCreate entries.Length while count > 0 do count <- count - 1 let bucketIndex = hash entries.[count].key (newBuckets.Length - 1) entries.[count].next <- newBuckets.[bucketIndex] - 1 newBuckets.[bucketIndex] <- count + 1 _buckets <- newBuckets _entries <- entries entries member c.GetEnumerator() = new Enumerator<'TKey,'TValue>(c) interface IEnumerable> with member c.GetEnumerator() = new Enumerator<'TKey,'TValue>(c) :> IEnumerator<_> interface IEnumerable with member c.GetEnumerator() = new Enumerator<'TKey,'TValue>(c) :> IEnumerator and internal Enumerator<'TKey, 'TValue when 'TKey :> IEquatable<'TKey> and 'TKey : equality> = val _dictionary : DictionarySlim<'TKey, 'TValue> val mutable _index : int val mutable _count : int val mutable _current : KeyValuePair<'TKey, 'TValue> new(dict) = { _dictionary = dict _index = 0 _count = dict.Count _current = Unchecked.defaultof<_> } member c.MoveNext() = if c._count = 0 then c._current <- Unchecked.defaultof<_> false else c._count <- c._count - 1 while c._dictionary.Entries.[c._index].next < -1 do c._index <- c._index + 1 c._current <- new KeyValuePair<'TKey, 'TValue>( c._dictionary.Entries.[c._index].key, c._dictionary.Entries.[c._index].value) c._index <- c._index + 1 true member c.Current = c._current member c.Reset() = c._index <- 0 c._count <- c._dictionary.Count c._current <- Unchecked.defaultof<_> interface IEnumerator with member c.Current = c._current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() interface IEnumerator> with member c.Current = c._current member c.Dispose() = () ================================================ FILE: src/Garnet/Comparisons.fs ================================================ namespace Garnet.Composition // The purpose of this is to avoid equality operator allocations for value types. // Be careful if using this with floating point values. // https://github.com/dotnet/fsharp/issues/526 // https://zeckul.wordpress.com/2015/07/09/how-to-avoid-boxing-value-types-in-f-equality-comparisons/ #nowarn "86" module Comparisons = let inline eq<'a when 'a :> System.IEquatable<'a>> (x:'a) (y:'a) = x.Equals y let inline (=) x y = eq x y let inline (<>) x y = not (eq x y) let inline (=@) x y = Microsoft.FSharp.Core.Operators.(=) x y let inline (<>@) x y = Microsoft.FSharp.Core.Operators.(<>) x y let inline lt<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) < 0 let inline gt<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) > 0 let inline lte<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) <= 0 let inline gte<'a when 'a :> System.IComparable<'a>> (x:'a) (y:'a) = x.CompareTo(y) >= 0 let inline (<) x y = lt x y let inline (>) x y = gt x y let inline (<=) x y = lte x y let inline (>=) x y = gte x y let inline isNull x = obj.ReferenceEquals(x, null) let inline isNotNull x = not (isNull x) ================================================ FILE: src/Garnet/Components.fs ================================================ namespace Garnet.Composition open System open System.Runtime.InteropServices open Garnet.Composition.Comparisons type ISegmentKeyMapper<'k, 'c> = abstract GetSegmentKey : 'c -> 'k abstract GetComponentIndex : 'c -> int module IdSegmentMapper = let inline getSegmentKey<'k, 'c, 'm when 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>> (id : 'c) = Unchecked.defaultof<'m>.GetSegmentKey(id) let inline getComponentIndex<'k, 'c, 'm when 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>> (id : 'c) = Unchecked.defaultof<'m>.GetComponentIndex(id) /// Adds convenience methods to access individual components [] type Components<'k, 'c, 'm, 'a when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality and 'c :> IComparable<'c> and 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>>(segments : Segments<'k, 'a>) = member c.Segments = segments member c.Count = segments.GetComponentCount() member internal c.Components = segments.Components member c.Clear() = segments.Clear() member c.Commit() = segments.Commit() member c.Contains(id) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id let mask = segments.GetMask sid (mask &&& (1UL <<< ci)) <> 0UL member c.Get(id : 'c) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id let seg = segments.Get(sid) if seg.Mask &&& (1UL <<< ci) = 0UL then failwithf "Cannot get %s %s" (Format.typeToString typeof<'a>) (id.ToString()) &seg.Data.[ci] member c.Set(id, value) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id let seg = segments.Get(sid) if seg.Mask &&& (1UL <<< ci) = 0UL then failwithf "Cannot set %s %s" (Format.typeToString typeof<'a>) (id.ToString()) seg.Data.[ci] <- value member c.TryGet(id, [] value : byref<_>)= let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id match segments.TryFind(sid) with | false, _ -> value <- Unchecked.defaultof<_> false | true, si -> let s = segments.[si] if s.Mask &&& (1UL <<< ci) = 0UL then value <- Unchecked.defaultof<_> false else value <- s.Data.[ci] true member c.GetOrDefault(id, fallback) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id match segments.TryFind(sid) with | false, _ -> fallback | true, si -> let s = segments.[si] if s.Mask &&& (1UL <<< ci) = 0UL then fallback else s.Data.[ci] member c.Copy(srcId, destId) = let mutable value = Unchecked.defaultof<_> if c.TryGet(srcId, &value) then c.Add(destId, value) else c.Remove(destId) member c.Add(id, value) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id let data = segments.Add(sid, 1UL <<< ci) data.[ci] <- value /// Removes single component member c.Remove(id) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id segments.Remove(sid, 1UL <<< ci) override c.ToString() = segments.ToString() static member Create() = Components<'k, 'c, 'm, 'a>(Segments<'k, 'a>()) type IComponentStore<'k, 'c, 'm when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality and 'c :> IComparable<'c> and 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>> = abstract member GetComponents<'b> : unit -> Components<'k, 'c, 'm, 'b> type ComponentStore<'k, 'c, 'm when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality and 'c :> IComparable<'c> and 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>>(segments : SegmentStore<'k>) = new() = ComponentStore(SegmentStore()) member c.Segments = segments member c.GetSegments<'a>() = segments.GetSegments<'a>() member c.GetComponents<'a>() = Components(segments.GetSegments<'a>()) member c.Clear() = segments.Clear() member c.Handle(param, id, handler) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id let mask = 1UL <<< ci segments.Handle(param, sid, mask, handler) member c.Handle(param, sid, mask, handler) = segments.Handle(param, sid, mask, handler) member c.Handle(param, handler) = segments.Handle(param, handler) /// Removes ID component and assumes other components /// will be cleaned up in commit member c.Destroy(id) = let sid = IdSegmentMapper.getSegmentKey<'k, 'c, 'm> id let ci = IdSegmentMapper.getComponentIndex<'k, 'c, 'm> id segments.GetSegments<'c>().Remove(sid, 1UL <<< ci) member c.Commit() = segments.Commit() interface IComponentStore<'k, 'c, 'm> with member c.GetComponents<'a>() = c.GetComponents<'a>() interface ISegmentStore<'k> with member c.Handle(param, handler) = c.Handle(param, handler) member c.Handle(param, sid, mask, handler) = c.Handle(param, sid, mask, handler) member c.GetSegments<'a>() = segments.GetSegments<'a>() override c.ToString() = segments.ToString() [] type Entity<'k, 'c, 'm when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality and 'c :> IComparable<'c> and 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>> = val Id : 'c val Components : ComponentStore<'k, 'c, 'm> new(id, components) = { Id = id; Components = components } member c.Add(x) = c.Components.GetComponents<_>().Add(c.Id, x) member c.Set(x) = c.Components.GetComponents<_>().Set(c.Id, x) member c.Remove<'a>() = c.Components.GetComponents<'a>().Remove(c.Id) member c.Get<'a>() = &c.Components.GetComponents<'a>().Get(c.Id) member c.CopyTo<'a> destId = c.Components.GetComponents<'a>().Copy(c.Id, destId) member c.TryGet<'a>([] value : byref<_>) = c.Components.GetComponents<'a>().TryGet(c.Id, &value) member c.GetOrDefault<'a> fallback = c.Components.GetComponents<'a>().GetOrDefault(c.Id, fallback) member c.Has<'a>() = c.Components.GetComponents<'a>().Contains(c.Id) member c.Destroy() = c.Components.Destroy(c.Id) member c.With(x) = c.Add(x); c member c.Without<'a>() = c.Remove<'a>(); c override c.ToString() = let printer = PrintHandler<'k>(UInt64.MaxValue) c.Components.Handle((), c.Id, printer) "Entity " + c.Id.ToString() + ": " + printer.ToString() type ComponentStore<'k, 'c, 'm when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality and 'c :> IComparable<'c> and 'm : struct and 'm :> ISegmentKeyMapper<'k, 'c>> with member c.Get(id) = Entity(id, c) ================================================ FILE: src/Garnet/Containers.fs ================================================ namespace Garnet.Composition open System open System.Buffers open System.Collections.Generic open System.Runtime.InteropServices open Garnet.Composition.Comparisons type DisposableReference<'a when 'a :> IDisposable>(init : 'a) = let mutable current = init member c.Value = current member c.Set(create) = current.Dispose() current <- create() member c.Dispose() = current.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() /// Wrapper over resource lookup with default types for ECS type Container() = let reg = Registry() let channels = reg.Get() let scheduler = reg.Get() let segments = reg.Get>() let outbox = reg.Get() let eidPools = reg.Get() let resources = reg.Get() let components = ComponentStore(segments) let eids = segments.GetSegments() member c.GetComponents<'a>() = components.GetComponents<'a>() member c.GetSegments<'a>() = segments.GetSegments<'a>() member c.GetChannel<'a>() = channels.GetChannel<'a>() member c.SetFactory(x) = reg.SetFactory(x) member c.Set(x) = reg.Set(x) member c.Get() = ®.Get() member c.TryGet<'a>([] value : byref<'a>) = reg.TryGet<'a>(&value) member c.AddResource<'a>(key, resource) = resources.AddResource<'a>(key, resource) member c.TryGetResource<'a>(key, [] value : byref<'a>) = resources.TryGetResource(key, &value) member c.LoadResource<'a> key = resources.LoadResource<'a>(key) member c.Iter(param, handler) = reg.Iter(param, handler) member c.GetAddresses() = outbox.Current.Addresses member internal c.Clear() = channels.Clear() components.Clear() eidPools.Clear() scheduler.Clear() member c.Commit() = // Order of commits doesn't matter since we're just moving data // into committed state and not calling any handlers. channels.Commit() // Copy removals from eids to other component types first, // then apply eid changes to partition cache, then after all // this commit all resulting component changes. segments.ApplyRemovalsFrom(eids) eidPools.Apply(eids) components.Commit() /// Returns true if events were handled member private c.DispatchOnce() = c.Commit() channels.Publish() member private c.DispatchAll() = while c.DispatchOnce() do () member private c.RunOnce() = c.Commit() scheduler.RunOnce() member c.Run() = c.DispatchAll() while c.RunOnce() do c.DispatchAll() member c.Contains(eid : Eid) = let sid = eid.SegmentIndex let ci = eid.ComponentIndex let mask = eids.GetMask sid (mask &&& (1UL <<< ci)) <> 0UL member c.Get(eid) = Entity(eid, components) member internal c.CreateEid(partition) = let eid = eidPools.Next(partition) let sid = eid.SegmentIndex let ci = eid.ComponentIndex let data = eids.Add(sid, 1UL <<< ci) data.[ci] <- eid eid member c.Handle(param, handler : ISegmentListHandler<_, int>) = segments.Handle(param, handler) member c.Handle(param, sid, mask, handler) = segments.Handle(param, sid, mask, handler) member c.Handle(param, id, handler) = components.Handle(param, id, handler) member c.Destroy(eid : Eid) = // Only removing from eids and relying on commit to remove // other components. let sid = eid.SegmentIndex let ci = eid.ComponentIndex eids.Remove(sid, 1UL <<< ci) member c.Step(deltaTime) = scheduler.Step(deltaTime) member c.Start(coroutine) = scheduler.Schedule(coroutine) member c.SetPublisher(pub) = channels.SetPublisher(pub) member c.SetPublisher(pub) = c.SetPublisher(ValueSome pub) member c.UnsubscribeAll() = channels.Clear() interface IRegistry with member c.SetFactory(x) = c.SetFactory(x) member c.Set(x) = c.Set(x) member c.Get() = &c.Get() member c.TryGet<'a>([] value) = c.TryGet<'a>(&value) member c.Iter(param, handler) = c.Iter(param, handler) interface IResourceCache with member c.TryGetResource<'a>(key, [] value : byref<'a>) = c.TryGetResource<'a>(key, &value) member c.LoadResource<'a> key = c.LoadResource<'a>(key) member c.AddResource(key, resource) = c.AddResource(key, resource) interface IChannels with member c.GetChannel<'a>() = channels.GetChannel<'a>() interface IComponentStore with member c.GetComponents<'a>() = components.GetComponents<'a>() interface ISegmentStore with member c.Handle(param, handler) = c.Handle(param, handler) member c.Handle(param, sid, mask, handler) = c.Handle(param, sid, mask, handler) member c.GetSegments<'a>() = segments.GetSegments<'a>() member c.SendAll(message, deliveryId) = outbox.SendAll(message, deliveryId) interface IOutbox with member c.SendAll(message, deliveryId) = outbox.SendAll(message, deliveryId) member c.Receive(currentOutbox, message) = // assign outbox for duration of call use s = outbox.Push(currentOutbox, message) let channel = c.GetChannel<'a>() channel.PublishAll(ReadOnlyMemory(message.Buffer, 0, message.Count)) c.Run() interface IInbox with member c.Receive(outbox, message) = c.Receive(outbox, message) override c.ToString() = reg.ToString() type SystemRegistry() = let dict = Dictionary>() member private c.GetSubscription(name) = Disposable.Create(fun () -> dict.[name].Dispose() dict.Remove(name) |> ignore) member c.Contains(name) = dict.ContainsKey(name) member c.Add(name, create) = match dict.TryGetValue(name) with | true, entry -> entry.Set(create) | false, _ -> let entry = new DisposableReference<_>(create()) dict.Add(name, entry) c.GetSubscription(name) member c.Dispose() = for entry in dict.Values do entry.Dispose() dict.Clear() member c.ToString(writer : IStringBlockWriter) = if writer.BeginList("Systems", dict.Count) then for name in Seq.sort dict.Keys do writer.Write(name) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) type Container with member c.GetSourceId() = c.GetAddresses().SourceId member c.GetDestinationId() = c.GetAddresses().DestinationId member c.BeginSend<'a>() = let writer = c.Get>() writer.Outbox <- c writer member c.BeginSend<'a>(destId : ActorId) = let writer = c.BeginSend<'a>() writer.DestinationId <- destId writer member c.BeginSend<'a>(destId : ActorId, sourceId : ActorId) = let writer = c.BeginSend<'a>() writer.DestinationId <- destId writer.SourceId <- sourceId writer member c.BeginSend<'a>(destId : ActorId, sourceId : ActorId, deliveryId) = let writer = c.BeginSend<'a>() writer.DestinationId <- destId writer.SourceId <- sourceId writer.DeliveryId <- deliveryId writer member c.Create(partition) = let eid = c.CreateEid(partition) c.Get eid member c.Create() = c.Create(0) member c.Create(eid : Eid) = c.Get(eid).With(eid) member c.DestroyAll() = c.GetSegments().RemoveAll() member c.Run(msg) = c.Send(msg) c.Run() member c.BeginRespond() = c.BeginSend(c.GetSourceId()) member c.Respond(message) = c.Send(c.GetSourceId(), message) member c.AddSystems(systems) = systems |> Seq.map (fun sys -> sys c) |> Disposable.Create member c.AddSystem(name : string, register : Container -> IDisposable) = let reg = c.Get() reg.Add(name, fun () -> register c) member c.AddSystem(actorId, actorOutbox, register : Container -> IDisposable) = let outbox = c.Get() use s = outbox.Push(actorOutbox, { SourceId = ActorId.Undefined DestinationId = actorId Pool = ArrayPool.Shared Buffer = ArrayPool.Shared.Rent(1) Count = 1 }) let sub = register c c.Commit() sub /// Stores a state value in registry and calls registration when state events occur. /// This is useful for allowing a container to have multiple states with their own /// subscriptions and transition logic. member c.AddStateMachine<'a>(initState, registerState) = let state = new DisposableReference(Disposable.Null) let setState e = c.Set<'a>(e) // Register subscriptions specific to new state, replacing prior state.Set(fun () -> registerState e c) setState initState Disposable.Create [ // when state message arrives c.On<'a> setState state :> IDisposable ] static member Create(register : Container -> IDisposable) = let c = Container() register c |> ignore c.Commit() c /// Allows container creation in actor thread instead of main thread type LazyContainerInbox(actorId, register) = let container = Container() let mutable sub = Disposable.Null let mutable isCreated = false interface IInbox with member c.Receive(outbox, message) = if not isCreated then sub <- container.AddSystem(actorId, outbox, register) isCreated <- true container.Receive(outbox, message) member c.Dispose() = sub.Dispose() interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: src/Garnet/Coroutines.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open Garnet.Composition.Comparisons [] type Wait = val Duration : int64 new(duration) = { Duration = duration } static member All = Wait(-1L) type internal StackScheduler() = let temp = List<_>() let pending = List<_>() let active = List<_>() let frames = List<_>() member c.Clear() = pending.Clear() active.Clear() frames.Clear() member c.Schedule(coroutine : Wait seq) = pending.Add coroutine member c.Enqueue e = active.Add e // Returns true if work was done member c.RunOnce(iterate : Action<_>) = let hasPending = pending.Count > 0 if hasPending then frames.Add(pending.Count) for coroutine in pending do let e = coroutine.GetEnumerator() c.Enqueue e pending.Clear() let hasFrames = frames.Count > 0 if hasFrames then let frameSize = frames.[frames.Count - 1] let priorActiveCount = active.Count let frameStart = active.Count - frameSize // transfer into temp list and clear frame for i = frameStart to active.Count - 1 do temp.Add(active.[i]) active.RemoveRange(frameStart, frameSize) // run coroutines, possibly re-enqueuing try for e in temp do iterate.Invoke e finally temp.Clear() // update frame let removedCount = priorActiveCount - active.Count let newFrameSize = frameSize - removedCount if newFrameSize = 0 then frames.RemoveAt(frames.Count - 1) else frames.[frames.Count - 1] <- newFrameSize hasPending || hasFrames override c.ToString() = sprintf "Stack: %d pending, %d active, frames: %s" pending.Count active.Count (String.Join(", ", frames)) type internal TimeScheduler() = let mutable time = 0L let active = Garnet.Composition.PriorityQueue() member c.Enqueue(e : IEnumerator) = let delay = e.Current.Duration let nextTime = time + delay active.Enqueue(nextTime, e) member c.RunOnce(iterate : Action<_>) = let mutable iterCount = 0 while active.Count > 0 && active.Top.Key <= time do iterCount <- iterCount + 1 let e = active.Dequeue() iterate.Invoke e iterCount > 0 member c.Step(deltaTime) = time <- time + deltaTime member c.Clear() = active.Clear() time <- 0L override c.ToString() = sprintf "Timed: %d total, due: %s" active.Count (String.Join(", ", active.Items |> Seq.map (fun p -> p.Key))) type CoroutineScheduler() = let timed = TimeScheduler() let stacked = StackScheduler() let iterate = Action<_>(fun (e : IEnumerator) -> let isContinued = try e.MoveNext() with | ex -> let str = sprintf "Error in coroutine %s" (e.ToString()) exn(str, ex) |> raise if isContinued then // Add to queue based on scheduling type: // - Non-negative indicates we want to wait for some duration // - Negative indicates we want to wait on nested coroutines let isTimed = e.Current.Duration >= 0L if isTimed then timed.Enqueue e else stacked.Enqueue e) member c.Schedule(coroutine) = stacked.Schedule(coroutine) member c.RunOnce() = let hasStacked = stacked.RunOnce(iterate) let hasTimed = timed.RunOnce(iterate) hasStacked || hasTimed member c.Run() = while c.RunOnce() do () member c.Step(deltaTime) = timed.Step(deltaTime) member c.Clear() = timed.Clear() stacked.Clear() override c.ToString() = sprintf "Coroutines\n %s\n %s" (stacked.ToString()) (timed.ToString()) ================================================ FILE: src/Garnet/Entities.fs ================================================ namespace Garnet.Composition open System open System.Runtime.CompilerServices open Garnet.Composition.Comparisons module Eid = // Entity ID bits: // gggg gggg [ pppp xxxx xxxx xxxx xxxx xxxx ] // (8) g: generation, max 256 // (24) Slot: // (4) p: partition, max 16 // (20) x: index, max ~1,000,000 [] let TotalBits = 32 [] let GenBits = 8 [] let GenCount = 256 [] let GenMask = 255 [] let MaxGen = GenMask [] let SlotBits = 24 [] let SlotCount = 0x1000000 [] let SlotMask = 0xffffff [] let PartitionBits = 4 [] let PartitionCount = 0x10 [] let PartitionMask = 0xf [] let IndexBits = 20 [] let IndexCount = 0x100000 [] let IndexMask = 0xfffff [] let SegmentToPartitionBits = 14 [] let SegmentInPartitionMask = 0x3fff /// 32-bit entity ID [] type Eid = val Value : int new(value) = { Value = value } new(gen, partition, index) = { Value = (gen <<< Eid.SlotBits) ||| (partition <<< Eid.IndexBits) ||| index } member inline eid.IsDefined = eid.Value <> 0 member inline eid.IsUndefined = eid.Value = 0 member inline eid.Index = eid.Value &&& Eid.IndexMask member inline eid.Slot = eid.Value &&& Eid.SlotMask member inline eid.Gen = uint32 eid.Value >>> Eid.SlotBits |> int member inline eid.Partition = (eid.Value >>> Eid.IndexBits) &&& Eid.PartitionMask member inline eid.SegmentIndex = eid.Slot >>> Segment.SegmentBits member inline eid.ComponentIndex = eid.Value &&& Segment.SegmentMask member inline eid.WithGen(gen) = Eid(eid.Slot ||| (gen <<< Eid.SlotBits)) member inline eid.IncrementGen() = let next = (eid.Gen + 1) &&& Eid.GenMask eid.WithGen(next) override e.ToString() = "0x" + e.Value.ToString("x") member eid.ToPartString() = sprintf "%d %d %d" eid.Gen eid.Partition eid.Index static member inline Undefined = Eid 0 static member inline SegmentToPartition(sid) = sid >>> Eid.SegmentToPartitionBits [] type EidSegmentKeyMapper = interface ISegmentKeyMapper with [] member c.GetSegmentKey(id) = id.SegmentIndex [] member c.GetComponentIndex(id) = id.ComponentIndex type Entity = Entity type EidPool(partition) = let mutable known = Array.zeroCreate 1 let mutable used = Array.zeroCreate 1 let mutable eids = Array.zeroCreate 64 let mutable current = Segment.SegmentBits - 1 let mutable mask = 0UL member c.Used = Bits.bitCount64Array used member c.Allocated = Bits.bitCount64Array known member c.Total = c.Used + c.Allocated member c.SegmentCount = known.Length member private c.EnsureSize si = let required = si + 1 if used.Length < required then Buffer.resizeArray required &known Buffer.resizeArray required &used Buffer.resizeArray (required * 64) &eids member c.Clear() = Array.Clear(known, 0, known.Length) Array.Clear(used, 0, used.Length) Array.Clear(eids, 0, eids.Length) c.Reset() member c.Reset() = current <- Segment.SegmentBits - 1 mask <- 0UL member c.Next() = if mask = 0UL then // Seek until unused segment found. Note we always increment, // ensuring we start at segment 1 to avoid eid zero. let mutable si = (current >>> 6) + 1 c.EnsureSize si while used.[si] = UInt64.MaxValue do si <- si + 1 current <- si * 64 c.EnsureSize si // allocate new eids as needed let knownMask = known.[si] if knownMask <> UInt64.MaxValue then let offset = si * 64 let mutable m = ~~~knownMask let mutable i = offset while m <> 0UL do if m &&& 1UL <> 0UL then eids.[i] <- Eid(0, partition, i) m <- m >>> 1 i <- i + 1 known.[si] <- UInt64.MaxValue mask <- ~~~used.[si] current <- (si <<< 6) - 1 // increment first with assumption that we start at -1 current <- current + 1 // advance to next unused slot with segment while mask &&& 1UL = 0UL do mask <- mask >>> 1 current <- current + 1 // claim eid and advance to next let eid = eids.[current] mask <- mask >>> 1 eid member c.Recycle(eid : Eid) = c.Apply { Data = null Id = eid.SegmentIndex Mask = 0UL RemovalMask = 1UL <<< eid.ComponentIndex } member internal c.Apply(seg : PendingSegment) = let sid = seg.Id &&& Eid.SegmentInPartitionMask c.EnsureSize sid let offset = sid * 64 if seg.Mask &&& seg.RemovalMask <> 0UL then failwithf "Segment contains overlapping add/remove" // When eid added and not previously known, write to pool with // incremented gen. if seg.Mask <> 0UL then let addMask = seg.Mask &&& ~~~known.[sid] let mutable m = addMask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then eids.[offset + i] <- seg.Data.[i].IncrementGen() m <- m >>> 1 i <- i + 1 known.[sid] <- known.[sid] ||| addMask used.[sid] <- used.[sid] ||| seg.Mask // When eid removed, mark as unused and increment. if seg.RemovalMask <> 0UL then // Note we're not checking if used or not -- if not marked as used, // eid was created/destroyed before commit, but we still need to // return it to increment gen. let removalMask = seg.RemovalMask // Since removal seg doesn't have populated eids, we must take them // from stored value in pool, which means they must be known. In the // case of restore, expect that add would always be called first to // populate eids. if removalMask &&& known.[sid] <> removalMask then failwithf "Cannot return unknown IDs to pool" let mutable m = removalMask let mutable i = offset while m <> 0UL do if m &&& 1UL <> 0UL then eids.[i] <- eids.[i].IncrementGen() m <- m >>> 1 i <- i + 1 used.[sid] <- used.[sid] &&& ~~~removalMask c.Reset() override p.ToString() = let formatBits known used = Array.init 64 (fun i -> let k = (known >>> i) &&& 1UL let u = (used >>> i) &&& 1UL match k, u with | 0UL, 0UL -> ' ' | 0UL, 1UL -> 'u' | 1UL, 0UL -> '.' | 1UL, 1UL | _ -> 'x') |> String sprintf "%d alloc, %d used, %d total, %d segs%s" p.Allocated p.Used p.Total used.Length (seq { for i = 0 to used.Length - 1 do let k = known.[i] let u = used.[i] if k ||| u <> 0UL then yield sprintf "%d %s" i (formatBits k u) } |> Format.listToString " " "") type EidPools() = let pools = Array.init Eid.PartitionCount EidPool member c.Count = pools.Length member c.Next p = pools.[p].Next() member c.Apply(active : Segments) = for i = 0 to active.PendingCount - 1 do let seg = active.GetPending i let p = Eid.SegmentToPartition(seg.Id) pools.[p].Apply seg member c.Clear() = for pool in pools do pool.Clear() override c.ToString() = let prefix = "" pools |> Seq.mapi (fun i p -> if p.Total > 0 then sprintf "%d: %s" i (p.ToString()) else "") |> Seq.filter (fun str -> str.Length > 0) |> Format.listToString (prefix + " ") (prefix + "Pools") ================================================ FILE: src/Garnet/Formatting.fs ================================================ namespace Garnet.Composition open System open System.Collections open System.Collections.Generic open System.Text open Garnet.Composition.Comparisons /// Provides debug formatting for specific types type IFormatter = abstract member Format<'a> : 'a -> string abstract member CanFormat<'a> : unit -> bool /// Provides debug formatting for specific types type Formatter() = let skippedTypes = HashSet() let dict = Dictionary() member c.Skip(t : Type) = skippedTypes.Add(t) |> ignore member c.Skip<'a>() = c.Skip(typeof<'a>) member c.Register(t : Type, format) = dict.[t] <- format member c.Register<'a>(action : 'a -> string) = dict.[typeof<'a>] <- action member c.Format<'a> e = match dict.TryGetValue(typeof<'a>) with | true, x -> let handle = x :?> 'a -> string handle e | false, _ -> sprintf "%A" e interface IFormatter with member c.Format<'a> e = c.Format<'a> e member c.CanFormat<'a>() = not (skippedTypes.Contains(typeof<'a>)) type IStringBlockWriter = abstract Begin : string * string -> bool abstract Write : string -> unit abstract End : unit -> unit [] module StringBlockWriter = type IStringBlockWriter with member c.Begin(name) = c.Begin(name, name) member c.BeginList(name, count) = let str = sprintf "%s (%d)" name count if count = 0 then c.Write(str); false else c.Begin(str, name) type StringBlockWriter() = let sb = StringBuilder() let mutable indent = 0 member private c.AppendLine(str : string) = for i = 0 to indent - 1 do sb.Append(" ") |> ignore sb.AppendLine(str) |> ignore interface IStringBlockWriter with member c.Begin(name, _) = c.AppendLine(name) indent <- indent + 1 true member c.Write(text) = c.AppendLine(text) member c.End() = indent <- indent - 1 member c.Clear() = sb.Clear() override c.ToString() = sb.ToString() static member Format(toString) = let w = StringBlockWriter() toString w w.ToString() module internal Format = let private getNonGenericTypeName (name : string) = let last = name.LastIndexOf('`') if last < 0 then name else name.Substring(0, last) let rec typeToString (t : Type) = let name = getNonGenericTypeName t.Name let args = t.GetGenericArguments() if args.Length = 0 then name else sprintf "%s<%s>" name (String.Join(",", args |> Seq.map typeToString |> Seq.toArray)) let isEmptyType (t : Type) = not (t.IsPrimitive || t.IsEnum || t.GetProperties().Length > 0) let formatRecord indent value = let str = sprintf "%A" value str.Replace("\n", "\n" + indent) let listInfoToString (list : IList) = let args = list.GetType().GetGenericArguments() sprintf "%s (%d)" (args.[0] |> typeToString) list.Count let addIndent (str : string) = str.Replace("\n", "\n ") let formatList name count (str : string) = sprintf "%s (%d)%s" name count (if count > 0 then ":\n " + addIndent str else "") let listToString prefix title items = let str = String.Join("", items |> Seq.map (fun x -> "\n" + prefix + x.ToString()) |> Seq.toArray) sprintf "%s%s" title str let reverseString (str : string) = let ch = str.ToCharArray() Array.Reverse(ch) String(ch) let maskToString maxBits (mask : uint64) = Convert.ToString(int64 mask, 2) .PadLeft(maxBits, '0') .Replace('0', '.') .Replace('1', 'x') |> reverseString [] type CachedTypeInfo = { isEmpty : bool typeName : string } let isEnumerable<'a> = typeof<'a>.GetInterfaces() |> Seq.exists (fun i -> let isEnumerable = obj.ReferenceEquals(i, typeof) || obj.ReferenceEquals(i, typeof) let isGenericEnumerable = i.IsGenericType && (obj.ReferenceEquals(i.GetGenericTypeDefinition(), typeof>) || obj.ReferenceEquals(i.GetGenericTypeDefinition(), typeof>)) isEnumerable || isGenericEnumerable) type CachedTypeInfo<'a>() = static member val Info = { // special cases // - strings already have logging // - don't want enumerators to execute typeName = "Handle " + typeToString typeof<'a> isEmpty = isEmptyType typeof<'a> } let formatMessagesTo (sb : StringBuilder) (formatMsg : _ -> string) (batch : ReadOnlySpan<_>) maxCount = let printCount = min batch.Length maxCount for i = 0 to printCount - 1 do let msg = batch.[i] sb.AppendLine() |> ignore sb.Append(" ") |> ignore sb.Append(formatMsg msg) |> ignore //sb.Append(sprintf "%A" msg) |> ignore // count of messages not printed let remaining = batch.Length - printCount if remaining > 0 then sb.AppendLine() |> ignore sb.Append(sprintf " +%d" remaining) |> ignore let formatIndexedList prefix (segments : ReadOnlyMemory<_>) = segments.ToArray() |> Seq.mapi (fun i x -> sprintf "%d %s" i (x.ToString())) |> listToString prefix "" ================================================ FILE: src/Garnet/Garnet.fsproj ================================================  netstandard2.0;net6.0 F# game composition library, including ECS and actor-like messaging. fsharp ecs actor entity component game ================================================ FILE: src/Garnet/Messaging.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.Buffers open System.Threading open Garnet.Composition.Comparisons /// Identifies an actor [] type ActorId = val Value : int new(value) = { Value = value } override e.ToString() = "0x" + e.Value.ToString("x") member e.IsDefined = e.Value <> 0 member e.IsUndefined = e.Value = 0 static member inline Undefined = ActorId 0 [] type Message<'a> = { Buffer : 'a[] Count : int SourceId : ActorId DestinationId : ActorId Pool : ArrayPool<'a> } type IOutbox = abstract member SendAll<'a> : Message<'a> * ActorId -> unit [] module Mailbox = type IBufferWriter<'a> with member c.WriteValue(x) = c.GetSpan(1).[0] <- x c.Advance(1) type IOutbox with member c.Send<'a>(destId : ActorId, payload : 'a) = c.Send(destId, ActorId.Undefined, destId, payload) member c.Send<'a>(destId : ActorId, sourceId : ActorId, payload : 'a) = c.Send(destId, sourceId, destId, payload) member c.Send<'a>(destId : ActorId, sourceId : ActorId, deliveryId : ActorId, payload : 'a) = let arr = ArrayPool.Shared.Rent(1) arr.[0] <- payload c.SendAll({ Buffer = arr Count = 1 SourceId = sourceId DestinationId = destId Pool = ArrayPool.Shared }, deliveryId) member c.SendAll<'a>(destId : ActorId, payload : ReadOnlySpan<'a>) = c.SendAll(destId, ActorId.Undefined, destId, payload) member c.SendAll<'a>(destId : ActorId, sourceId : ActorId, payload : ReadOnlySpan<'a>) = c.SendAll(destId, sourceId, destId, payload) member c.SendAll<'a>(destId : ActorId, sourceId : ActorId, deliveryId : ActorId, payload : ReadOnlySpan<'a>) = let arr = ArrayPool.Shared.Rent(payload.Length) payload.CopyTo(arr.AsSpan()) c.SendAll({ Buffer = arr Count = payload.Length SourceId = sourceId DestinationId = destId Pool = ArrayPool.Shared }, deliveryId) type NullOutbox() = static let mutable instance = NullOutbox() :> IOutbox static member Instance = instance interface IOutbox with member c.SendAll<'a>(message : Message<'a>, _) = if message.Buffer.Length > 0 then message.Pool.Return(message.Buffer, true) /// Similar to ArrayBufferWriter, but uses ArrayPool for allocations type MessageWriter<'a>() = let mutable arr = Array.Empty<'a>() let mutable pos = 0 member val Outbox = NullOutbox.Instance with get, set member val SourceId = ActorId.Undefined with get, set member val DestinationId = ActorId.Undefined with get, set member val DeliveryId = ActorId.Undefined with get, set member c.WrittenCount = pos member c.WrittenSpan = ReadOnlySpan(arr, 0, pos) member c.WrittenMemory = ReadOnlyMemory(arr, 0, pos) member c.Allocate(minSize) = // Note min allocation in case count is zero let required = pos + max minSize 16 if required > arr.Length then let newMem = ArrayPool.Shared.Rent(required) arr.CopyTo(newMem, 0) ArrayPool.Shared.Return(arr, true) arr <- newMem member c.WriteValue(x) = if pos >= arr.Length then c.Allocate(1) arr.[pos] <- x pos <- pos + 1 member c.Advance(count) = pos <- pos + count member c.GetMemory(minSize) = c.Allocate(minSize) Memory(arr, pos, arr.Length - pos) member c.GetSpan(minSize) = c.GetMemory(minSize).Span member c.Clear() = if arr.Length > 0 then ArrayPool.Shared.Return(arr, true) arr <- Array.Empty<'a>() pos <- 0 c.Outbox <- NullOutbox.Instance c.SourceId <- ActorId.Undefined c.DestinationId <- ActorId.Undefined c.DeliveryId <- ActorId.Undefined member c.Send() = if pos > 0 then c.Outbox.SendAll({ Buffer = arr Count = pos SourceId = c.SourceId DestinationId = c.DestinationId Pool = ArrayPool.Shared }, if c.DeliveryId.IsDefined then c.DeliveryId else c.DestinationId) arr <- Array.Empty<'a>() c.Clear() member c.Dispose() = c.Send() interface IDisposable with member c.Dispose() = c.Send() interface IBufferWriter<'a> with member c.Advance(count) = c.Advance(count) member c.GetMemory(minSize) = c.GetMemory(minSize) member c.GetSpan(minSize) = c.GetSpan(minSize) type IInbox = abstract member Receive<'a> : IOutbox * Message<'a> -> unit type internal MessageTypeId() = static let mutable id = 0 static member GetNext() = Interlocked.Increment(&id) type internal MessageTypeId<'a>() = static let mutable id = MessageTypeId.GetNext() static member Id = id type Mailbox() = let mutable lookup = Array.zeroCreate(8) let mutable outbox = NullOutbox() :> IOutbox let mutable sourceId = ActorId.Undefined let mutable destId = ActorId.Undefined member c.SourceId = sourceId member c.DestinationId = destId member c.OnAll<'a>(action : ReadOnlyMemory<'a> -> unit) = let id = MessageTypeId<'a>.Id Buffer.resizeArray (id + 1) &lookup let combined = let h = lookup.[id] if isNotNull h then let existing = h :?> ReadOnlyMemory<'a> -> unit fun e -> existing e action e else action lookup.[id] <- combined :> obj member c.On<'a>(handle : 'a -> unit) = c.OnAll<'a>(fun buffer -> let span = buffer.Span for i = 0 to span.Length - 1 do handle span.[i]) member c.TryReceive<'a>(currentOutbox : IOutbox, e : Message<'a>) = let id = MessageTypeId<'a>.Id if id < lookup.Length then let h = lookup.[id] if isNotNull h then outbox <- currentOutbox sourceId <- e.SourceId destId <- e.DestinationId try let handle = h :?> ReadOnlyMemory<'a> -> unit handle (ReadOnlyMemory(e.Buffer, 0, e.Count)) true finally outbox <- NullOutbox.Instance sourceId <- ActorId.Undefined destId <- ActorId.Undefined else false else false member c.Send<'a>(message, deliveryId) = outbox.Send<'a>(message, deliveryId) interface IInbox with member c.Receive(outbox, e) = c.TryReceive(outbox, e) |> ignore interface IOutbox with member c.SendAll<'a>(message, deliveryId) = outbox.SendAll<'a>(message, deliveryId) override c.ToString() = outbox.ToString() static member Create(register) = let inbox = Mailbox() register inbox inbox type Mailbox with member c.Respond(msg) = c.Send(c.SourceId, msg) type NullInbox() = static let mutable instance = NullInbox() :> IInbox static member Instance = instance interface IInbox with member c.Receive(_, _) = () type InboxCollection(handlers : IInbox[]) = new(handlers : IInbox seq) = InboxCollection(handlers |> Seq.toArray) interface IInbox with member c.Receive<'a>(outbox, e) = for handler in handlers do handler.Receive<'a>(outbox, e) override c.ToString() = Format.formatList "Inboxes" handlers.Length (String.Join("\n", handlers)) [] type Actor(inbox : IInbox, dispatcherId : int, dispose : unit -> unit) = static let mutable instance = Actor(NullInbox.Instance) static member Null = instance new(inbox, dispose) = Actor(inbox, 0, dispose) new(inbox, dispatcherId) = Actor(inbox, dispatcherId, ignore) new(inbox) = Actor(inbox, 0) member _.Inbox = inbox member _.DispatcherId = dispatcherId member _.Dispose() = dispose() member _.WithDispatcher(newId) = Actor(inbox, newId, dispose) type IActorFactory = abstract member TryCreate : ActorId -> ValueOption type internal ActorFactoryCollection() = let factories = List() member c.Add(factory) = factories.Add(factory) member c.TryCreate(createId : ActorId) = let mutable result = ValueNone let mutable i = factories.Count - 1 while result.IsNone && i >= 0 do result <- factories.[i].TryCreate(createId) i <- i - 1 result interface IActorFactory with member c.TryCreate(createId) = c.TryCreate(createId) type ActorFactory(tryCreate) = static let mutable instance = ActorFactory(fun _ -> ValueSome Actor.Null) :> IActorFactory static member Null = instance member c.TryCreate(createId : ActorId) = tryCreate createId interface IActorFactory with member c.TryCreate(createId) = c.TryCreate(createId) static member Create(tryCreate) = ActorFactory(tryCreate) :> IActorFactory static member Create(factories) = let c = ActorFactoryCollection() for factory in factories do c.Add(factory) c :> IActorFactory /// Creates for any actor ID static member Create(create : ActorId -> Actor) = ActorFactory(fun (createId : ActorId) -> create createId |> ValueSome) /// Creates conditionally for actor ID static member Create(predicate : ActorId -> bool, create : ActorId -> Actor) = ActorFactory(fun (createId : ActorId) -> if predicate createId then create createId |> ValueSome else ValueNone) :> IActorFactory /// Creates for a specific actor ID static member Create(actorId : ActorId, create : ActorId -> Actor) = ActorFactory.Create((=)actorId, create) /// Creates conditionally for actor ID static member Create(predicate : ActorId -> bool, register : ActorId -> Mailbox -> unit) = let create (createId : ActorId) = Actor(Mailbox.Create(register createId)) ActorFactory.Create(predicate, create) /// Creates for any actor ID static member Create(register : ActorId -> Mailbox -> unit) = let predicate (_ : ActorId) = true ActorFactory.Create(predicate, register) /// Creates for a specific actor ID static member Create(actorId : ActorId, register : ActorId -> Mailbox -> unit) = ActorFactory.Create((=)actorId, register) [] module ActorFactory = type IActorFactory with member c.Wrap(map) = let tryCreate (createId : ActorId) = match c.TryCreate(createId) with | ValueSome actor -> ValueSome (map createId actor) | ValueNone -> ValueNone ActorFactory.Create(tryCreate) member c.WithDispatcher(dispatcherId) = c.Wrap(fun _ actor -> actor.WithDispatcher(dispatcherId)) member c.Create(actorId) = match c.TryCreate(actorId) with | ValueSome actor -> actor | ValueNone -> Actor.Null type internal DisposableCollection<'a when 'a :> IDisposable>(items : 'a[]) = interface IDisposable with member c.Dispose() = for item in items do item.Dispose() type Disposable(dispose) = static let mutable instance = new Disposable(ignore) :> IDisposable static member Null = instance interface IDisposable with member c.Dispose() = dispose() static member Create(dispose) = new Disposable(dispose) :> IDisposable static member Create(items : IDisposable[]) = new DisposableCollection<_>(items) :> IDisposable static member Create(items : IDisposable seq) = Disposable.Create(items |> Seq.toArray) [] type Addresses = { SourceId : ActorId DestinationId : ActorId } with static member inline Undefined = { SourceId = ActorId.Undefined DestinationId = ActorId.Undefined } [] type internal MessageContext = { Addresses : Addresses Outbox : IOutbox } module internal MessageContext = let empty = { Addresses = Addresses.Undefined Outbox = NullOutbox.Instance } /// Need sender member indirection because container registrations /// need permanent reference while incoming messages have varying sender type internal Outbox() = let mutable sendCount = 0 let mutable pushCount = 0 let mutable popCount = 0 let mutable current = MessageContext.empty let outboxStack = Stack<_>() let popOutbox() = popCount <- popCount + 1 current <- outboxStack.Pop() let scope = new Disposable(popOutbox) member c.Current = current /// Set temporary outbox for a scope such as handling incoming message member c.Push(outbox, message : Message<_>) = let context = { Outbox = outbox Addresses = { SourceId = message.SourceId DestinationId = message.DestinationId } } outboxStack.Push(current) current <- context pushCount <- pushCount + 1 scope member c.SendAll(message, deliveryId) = current.Outbox.SendAll(message, deliveryId) sendCount <- sendCount + 1 interface IOutbox with member c.SendAll(message, deliveryId) = c.SendAll(message, deliveryId) override c.ToString() = sprintf "Outbox: %d outboxes, %d sent, %d/%d push/pop" outboxStack.Count sendCount pushCount popCount ================================================ FILE: src/Garnet/Queries.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.Runtime.CompilerServices open Garnet.Composition.Comparisons [] type MaskEnumerator = val mutable private mask : uint64 val mutable private i : int new(mask) = { mask = mask i = -1 } member c.Current = c.i [] member c.MoveNext() = // Alternative for .NET 3.0 onward // let skip = System.Numerics.BitOperations.TrailingZeroCount(c.mask) + 1 // c.mask <- c.mask >>> skip // c.i <- c.i + skip // c.i < 64 if c.mask = 0UL then false else while c.mask &&& 1UL = 0UL do c.mask <- c.mask >>> 1 c.i <- c.i + 1 c.mask <- c.mask >>> 1 c.i <- c.i + 1 true member c.Reset() = raise (NotSupportedException()) member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type MaskEnumerable = val Mask : uint64 new(mask) = { Mask = mask } member inline c.GetEnumerator() = new MaskEnumerator(c.Mask) interface IEnumerable with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentDescriptor<'k> = val Id : 'k val Mask : uint64 new(id, mask) = { Id = id; Mask = mask } member inline c.GetEnumerator() = new MaskEnumerator(c.Mask) interface IEnumerable with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentData<'a> = val Array : 'a[] val Offset : int new(array, offset) = { Array = array; Offset = offset } member inline c.Item with get i : byref<'a> = &c.Array.[c.Offset + i] member c.AsSpan() = Span(c.Array, c.Offset, Segment.SegmentSize) member c.AsReadOnlySpan() = ReadOnlySpan(c.Array, c.Offset, Segment.SegmentSize) type internal SD<'a> = SegmentData<'a> // ComponentBatchEnumerator // These are for iterating individual Items (read-only) in a batch. [] type ComponentBatchEnumerator<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1)) = { m = new MaskEnumerator(desc.Mask); s1 = s1 } member c.Current = let i = c.m.Current c.s1.[i] [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator<'s1> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val private s3 : SD<'s3> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2, s3)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2; s3 = s3 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i], c.s3.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val private s3 : SD<'s3> val private s4 : SD<'s4> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2, s3, s4)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2; s3 = s3; s4 = s4 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i], c.s3.[i], c.s4.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val private s3 : SD<'s3> val private s4 : SD<'s4> val private s5 : SD<'s5> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2, s3, s4, s5)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i], c.s3.[i], c.s4.[i], c.s5.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val private s3 : SD<'s3> val private s4 : SD<'s4> val private s5 : SD<'s5> val private s6 : SD<'s6> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2, s3, s4, s5, s6)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i], c.s3.[i], c.s4.[i], c.s5.[i], c.s6.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () [] type ComponentBatchEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : SD<'s1> val private s2 : SD<'s2> val private s3 : SD<'s3> val private s4 : SD<'s4> val private s5 : SD<'s5> val private s6 : SD<'s6> val private s7 : SD<'s7> val mutable private m : MaskEnumerator new(struct(desc : SegmentDescriptor<'k>, s1, s2, s3, s4, s5, s6, s7)) = { m = new MaskEnumerator(desc.Mask); s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6; s7 = s7 } member c.Current = let i = c.m.Current struct(c.s1.[i], c.s2.[i], c.s3.[i], c.s4.[i], c.s5.[i], c.s6.[i], c.s7.[i]) [] member c.MoveNext() = c.m.MoveNext() member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () // SegmentQueryResult [] type SegmentQueryResult<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment : SD<'s1> new(id, mask, s1) = { Id = id; Mask = mask; Segment = s1 } member c.Indices = MaskEnumerable(c.Mask) [] type SegmentQueryResult<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> new(id, mask, s1, s2) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2) [] type SegmentQueryResult<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> val Segment3 : SD<'s3> new(id, mask, s1, s2, s3) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2; Segment3 = s3 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2, c.Segment3) [] type SegmentQueryResult<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> val Segment3 : SD<'s3> val Segment4 : SD<'s4> new(id, mask, s1, s2, s3, s4) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2; Segment3 = s3; Segment4 = s4 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2, c.Segment3, c.Segment4) [] type SegmentQueryResult<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> val Segment3 : SD<'s3> val Segment4 : SD<'s4> val Segment5 : SD<'s5> new(id, mask, s1, s2, s3, s4, s5) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2; Segment3 = s3; Segment4 = s4; Segment5 = s5 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2, c.Segment3, c.Segment4, c.Segment5) [] type SegmentQueryResult<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> val Segment3 : SD<'s3> val Segment4 : SD<'s4> val Segment5 : SD<'s5> val Segment6 : SD<'s6> new(id, mask, s1, s2, s3, s4, s5, s6) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2; Segment3 = s3; Segment4 = s4; Segment5 = s5; Segment6 = s6 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2, c.Segment3, c.Segment4, c.Segment5, c.Segment6) [] type SegmentQueryResult<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val Id : 'k val Mask : uint64 val Segment1 : SD<'s1> val Segment2 : SD<'s2> val Segment3 : SD<'s3> val Segment4 : SD<'s4> val Segment5 : SD<'s5> val Segment6 : SD<'s6> val Segment7 : SD<'s7> new(id, mask, s1, s2, s3, s4, s5, s6, s7) = { Id = id; Mask = mask Segment1 = s1; Segment2 = s2; Segment3 = s3; Segment4 = s4; Segment5 = s5; Segment6 = s6; Segment7 = s7 } member c.Indices = MaskEnumerable(c.Mask) member c.Segments = struct(c.Segment1, c.Segment2, c.Segment3, c.Segment4, c.Segment5, c.Segment6, c.Segment7) // SegmentQueryEnumerator // These implement segment intersections (inner joins) for iterating over segments. [] type SegmentQueryEnumerator<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val mutable private i1 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> new(s1) = { s1 = s1 i1 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> } member c.Mask = c.descriptor.Mask member c.Item with get i = &c.data1.[i] member c.Current = struct(c.descriptor, c.data1) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count do let seg1 = c.s1.[c.i1] let n1 = seg1.Id let mask = seg1.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) found <- true c.i1 <- c.i1 + 1 found member c.Reset() = c.i1 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val mutable private i1 : int val mutable private i2 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> new(s1, s2) = { s1 = s1; s2 = s2 i1 = 0; i2 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let n1 = seg1.Id let n2 = seg2.Id if n1 < n2 then c.i1 <- c.i1 + 1 elif n2 < n1 then c.i2 <- c.i2 + 1 else let mask = seg1.Mask &&& seg2.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val mutable private i1 : int val mutable private i2 : int val mutable private i3 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> val mutable private data3 : SD<'s3> new(s1, s2, s3) = { s1 = s1; s2 = s2; s3 = s3 i1 = 0; i2 = 0; i3 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> data3 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.GetValue3(i) = &c.data3.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i], c.data3.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2, c.data3) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count && c.i3 < c.s3.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let seg3 = c.s3.[c.i3] let n1 = seg1.Id let n2 = seg2.Id let n3 = seg3.Id if n1 < n2 || n1 < n3 then c.i1 <- c.i1 + 1 elif n2 < n1 || n2 < n3 then c.i2 <- c.i2 + 1 elif n3 < n1 || n3 < n2 then c.i3 <- c.i3 + 1 else let mask = seg1.Mask &&& seg2.Mask &&& seg3.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) c.data3 <- SD(seg3.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 c.i3 <- c.i3 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0; c.i3 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2> * SD<'s3>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val mutable private i1 : int val mutable private i2 : int val mutable private i3 : int val mutable private i4 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> val mutable private data3 : SD<'s3> val mutable private data4 : SD<'s4> new(s1, s2, s3, s4) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4 i1 = 0; i2 = 0; i3 = 0; i4 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> data3 = Unchecked.defaultof<_> data4 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.GetValue3(i) = &c.data3.[i] member c.GetValue4(i) = &c.data4.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i], c.data3.[i], c.data4.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2, c.data3, c.data4) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count && c.i3 < c.s3.Count && c.i4 < c.s4.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let seg3 = c.s3.[c.i3] let seg4 = c.s4.[c.i4] let n1 = seg1.Id let n2 = seg2.Id let n3 = seg3.Id let n4 = seg4.Id if n1 < n2 || n1 < n3 || n1 < n4 then c.i1 <- c.i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 then c.i2 <- c.i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 then c.i3 <- c.i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 then c.i4 <- c.i4 + 1 else let mask = seg1.Mask &&& seg2.Mask &&& seg3.Mask &&& seg4.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) c.data3 <- SD(seg3.Data, 0) c.data4 <- SD(seg4.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 c.i3 <- c.i3 + 1 c.i4 <- c.i4 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0; c.i3 <- 0; c.i4 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val mutable private i1 : int val mutable private i2 : int val mutable private i3 : int val mutable private i4 : int val mutable private i5 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> val mutable private data3 : SD<'s3> val mutable private data4 : SD<'s4> val mutable private data5 : SD<'s5> new(s1, s2, s3, s4, s5) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5 i1 = 0; i2 = 0; i3 = 0; i4 = 0; i5 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> data3 = Unchecked.defaultof<_> data4 = Unchecked.defaultof<_> data5 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.GetValue3(i) = &c.data3.[i] member c.GetValue4(i) = &c.data4.[i] member c.GetValue5(i) = &c.data5.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i], c.data3.[i], c.data4.[i], c.data5.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2, c.data3, c.data4, c.data5) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count && c.i3 < c.s3.Count && c.i4 < c.s4.Count && c.i5 < c.s5.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let seg3 = c.s3.[c.i3] let seg4 = c.s4.[c.i4] let seg5 = c.s5.[c.i5] let n1 = seg1.Id let n2 = seg2.Id let n3 = seg3.Id let n4 = seg4.Id let n5 = seg5.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 then c.i1 <- c.i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 then c.i2 <- c.i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 then c.i3 <- c.i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 then c.i4 <- c.i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 then c.i5 <- c.i5 + 1 else let mask = seg1.Mask &&& seg2.Mask &&& seg3.Mask &&& seg4.Mask &&& seg5.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) c.data3 <- SD(seg3.Data, 0) c.data4 <- SD(seg4.Data, 0) c.data5 <- SD(seg5.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 c.i3 <- c.i3 + 1 c.i4 <- c.i4 + 1 c.i5 <- c.i5 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0; c.i3 <- 0; c.i4 <- 0; c.i5 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> val mutable private i1 : int val mutable private i2 : int val mutable private i3 : int val mutable private i4 : int val mutable private i5 : int val mutable private i6 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> val mutable private data3 : SD<'s3> val mutable private data4 : SD<'s4> val mutable private data5 : SD<'s5> val mutable private data6 : SD<'s6> new(s1, s2, s3, s4, s5, s6) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6 i1 = 0; i2 = 0; i3 = 0; i4 = 0; i5 = 0; i6 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> data3 = Unchecked.defaultof<_> data4 = Unchecked.defaultof<_> data5 = Unchecked.defaultof<_> data6 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.GetValue3(i) = &c.data3.[i] member c.GetValue4(i) = &c.data4.[i] member c.GetValue5(i) = &c.data5.[i] member c.GetValue6(i) = &c.data6.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i], c.data3.[i], c.data4.[i], c.data5.[i], c.data6.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2, c.data3, c.data4, c.data5, c.data6) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count && c.i3 < c.s3.Count && c.i4 < c.s4.Count && c.i5 < c.s5.Count && c.i6 < c.s6.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let seg3 = c.s3.[c.i3] let seg4 = c.s4.[c.i4] let seg5 = c.s5.[c.i5] let seg6 = c.s6.[c.i6] let n1 = seg1.Id let n2 = seg2.Id let n3 = seg3.Id let n4 = seg4.Id let n5 = seg5.Id let n6 = seg6.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 || n1 < n6 then c.i1 <- c.i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 || n2 < n6 then c.i2 <- c.i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 || n3 < n6 then c.i3 <- c.i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 || n4 < n6 then c.i4 <- c.i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 || n5 < n6 then c.i5 <- c.i5 + 1 elif n6 < n1 || n6 < n2 || n6 < n3 || n6 < n4 || n6 < n5 then c.i6 <- c.i6 + 1 else let mask = seg1.Mask &&& seg2.Mask &&& seg3.Mask &&& seg4.Mask &&& seg5.Mask &&& seg6.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) c.data3 <- SD(seg3.Data, 0) c.data4 <- SD(seg4.Data, 0) c.data5 <- SD(seg5.Data, 0) c.data6 <- SD(seg6.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 c.i3 <- c.i3 + 1 c.i4 <- c.i4 + 1 c.i5 <- c.i5 + 1 c.i6 <- c.i6 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0; c.i3 <- 0; c.i4 <- 0; c.i5 <- 0; c.i6 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5> * SD<'s6>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() [] type SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> val private s7 : Segments<'k, 's7> val mutable private i1 : int val mutable private i2 : int val mutable private i3 : int val mutable private i4 : int val mutable private i5 : int val mutable private i6 : int val mutable private i7 : int val mutable private descriptor : SegmentDescriptor<'k> val mutable private data1 : SD<'s1> val mutable private data2 : SD<'s2> val mutable private data3 : SD<'s3> val mutable private data4 : SD<'s4> val mutable private data5 : SD<'s5> val mutable private data6 : SD<'s6> val mutable private data7 : SD<'s7> new(s1, s2, s3, s4, s5, s6, s7) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6; s7 = s7 i1 = 0; i2 = 0; i3 = 0; i4 = 0; i5 = 0; i6 = 0; i7 = 0 descriptor = SegmentDescriptor<'k>(Unchecked.defaultof<'k>, 0UL) data1 = Unchecked.defaultof<_> data2 = Unchecked.defaultof<_> data3 = Unchecked.defaultof<_> data4 = Unchecked.defaultof<_> data5 = Unchecked.defaultof<_> data6 = Unchecked.defaultof<_> data7 = Unchecked.defaultof<_> } member c.GetValue1(i) = &c.data1.[i] member c.GetValue2(i) = &c.data2.[i] member c.GetValue3(i) = &c.data3.[i] member c.GetValue4(i) = &c.data4.[i] member c.GetValue5(i) = &c.data5.[i] member c.GetValue6(i) = &c.data6.[i] member c.GetValue7(i) = &c.data7.[i] member c.Mask = c.descriptor.Mask member c.Item with get i = struct(c.data1.[i], c.data2.[i], c.data3.[i], c.data4.[i], c.data5.[i], c.data6.[i], c.data7.[i]) member c.Current = struct(c.descriptor, c.data1, c.data2, c.data3, c.data4, c.data5, c.data6, c.data7) member c.MoveNext() = let mutable found = false while not found && c.i1 < c.s1.Count && c.i2 < c.s2.Count && c.i3 < c.s3.Count && c.i4 < c.s4.Count && c.i5 < c.s5.Count && c.i6 < c.s6.Count && c.i7 < c.s7.Count do let seg1 = c.s1.[c.i1] let seg2 = c.s2.[c.i2] let seg3 = c.s3.[c.i3] let seg4 = c.s4.[c.i4] let seg5 = c.s5.[c.i5] let seg6 = c.s6.[c.i6] let seg7 = c.s7.[c.i7] let n1 = seg1.Id let n2 = seg2.Id let n3 = seg3.Id let n4 = seg4.Id let n5 = seg5.Id let n6 = seg6.Id let n7 = seg7.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 || n1 < n6 || n1 < n7 then c.i1 <- c.i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 || n2 < n6 || n2 < n7 then c.i2 <- c.i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 || n3 < n6 || n3 < n7 then c.i3 <- c.i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 || n4 < n6 || n4 < n7 then c.i4 <- c.i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 || n5 < n6 || n5 < n7 then c.i5 <- c.i5 + 1 elif n6 < n1 || n6 < n2 || n6 < n3 || n6 < n4 || n6 < n5 || n6 < n7 then c.i6 <- c.i6 + 1 elif n7 < n1 || n7 < n2 || n7 < n3 || n7 < n4 || n7 < n5 || n7 < n6 then c.i7 <- c.i7 + 1 else let mask = seg1.Mask &&& seg2.Mask &&& seg3.Mask &&& seg4.Mask &&& seg5.Mask &&& seg6.Mask &&& seg7.Mask if mask <> 0UL then c.descriptor <- SegmentDescriptor<'k>(n1, mask) c.data1 <- SD(seg1.Data, 0) c.data2 <- SD(seg2.Data, 0) c.data3 <- SD(seg3.Data, 0) c.data4 <- SD(seg4.Data, 0) c.data5 <- SD(seg5.Data, 0) c.data6 <- SD(seg6.Data, 0) c.data7 <- SD(seg7.Data, 0) found <- true c.i1 <- c.i1 + 1 c.i2 <- c.i2 + 1 c.i3 <- c.i3 + 1 c.i4 <- c.i4 + 1 c.i5 <- c.i5 + 1 c.i6 <- c.i6 + 1 c.i7 <- c.i7 + 1 found member c.Reset() = c.i1 <- 0; c.i2 <- 0; c.i3 <- 0; c.i4 <- 0; c.i5 <- 0; c.i6 <- 0; c.i7 <- 0 member c.Dispose() = () interface IEnumerator * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5> * SD<'s6> * SD<'s7>)> with member c.Current = c.Current member c.Current = c.Current :> obj member c.Dispose() = () member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() // ComponentQueryEnumerator // These enumerate over all Items over all segments, so they combine // two enumerators (or for loops) into one. // Note they are reference types and actually return themself during // enumeration. This is so we can access byref members directly and // avoid overhead from returning a large struct type on each iteration. // Although GC impact appears low, we can consider pooling these objects // to avoid GC overhead if needed. // Unfortunately, this approach requires access components by numbered // fields like Value1, Value2, etc. There's an option to read values as // tuples using 'Values', but this is significantly slower. type ComponentQueryEnumerator<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1> val mutable private m : MaskEnumerator new(s1) = { si = new SegmentQueryEnumerator<_,_>(s1) m = new MaskEnumerator(0UL) } member c.Value = &c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2> val mutable private m : MaskEnumerator new(s1, s2) = { si = new SegmentQueryEnumerator<_,_,_>(s1, s2) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Values = c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2, 's3> val mutable private m : MaskEnumerator new(s1, s2, s3) = { si = new SegmentQueryEnumerator<_,_,_,_>(s1, s2, s3) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Value3 = &c.si.GetValue3(c.m.Current) member c.Values = struct(c.Value1, c.Value2, c.Value3) member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4> val mutable private m : MaskEnumerator new(s1, s2, s3, s4) = { si = new SegmentQueryEnumerator<_,_,_,_,_>(s1, s2, s3, s4) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Value3 = &c.si.GetValue3(c.m.Current) member c.Value4 = &c.si.GetValue4(c.m.Current) member c.Values = c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5> val mutable private m : MaskEnumerator new(s1, s2, s3, s4, s5) = { si = new SegmentQueryEnumerator<_,_,_,_,_,_>(s1, s2, s3, s4, s5) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Value3 = &c.si.GetValue3(c.m.Current) member c.Value4 = &c.si.GetValue4(c.m.Current) member c.Value5 = &c.si.GetValue5(c.m.Current) member c.Values = c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6> val mutable private m : MaskEnumerator new(s1, s2, s3, s4, s5, s6) = { si = new SegmentQueryEnumerator<_,_,_,_,_,_,_>(s1, s2, s3, s4, s5, s6) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Value3 = &c.si.GetValue3(c.m.Current) member c.Value4 = &c.si.GetValue4(c.m.Current) member c.Value5 = &c.si.GetValue5(c.m.Current) member c.Value6 = &c.si.GetValue6(c.m.Current) member c.Values = c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () type ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val mutable private si : SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7> val mutable private m : MaskEnumerator new(s1, s2, s3, s4, s5, s6, s7) = { si = new SegmentQueryEnumerator<_,_,_,_,_,_,_,_>(s1, s2, s3, s4, s5, s6, s7) m = new MaskEnumerator(0UL) } member c.Value1 = &c.si.GetValue1(c.m.Current) member c.Value2 = &c.si.GetValue2(c.m.Current) member c.Value3 = &c.si.GetValue3(c.m.Current) member c.Value4 = &c.si.GetValue4(c.m.Current) member c.Value5 = &c.si.GetValue5(c.m.Current) member c.Value6 = &c.si.GetValue6(c.m.Current) member c.Value7 = &c.si.GetValue7(c.m.Current) member c.Values = c.si.[c.m.Current] member c.Current = c [] member c.MoveNext() = if c.m.MoveNext() then true else let mutable found = c.si.MoveNext() while found && c.si.Mask = 0UL do found <- c.si.MoveNext() if found then c.m <- new MaskEnumerator(c.si.Mask) c.m.MoveNext() |> ignore found member c.Reset() = c.m.Reset() member c.Dispose() = () interface IEnumerator> with member c.Current = c.Current member c.Current = c.Current :> obj member c.MoveNext() = c.MoveNext() member c.Reset() = c.Reset() member c.Dispose() = () // SegmentQuery // These each store a set of segment lists for iterating/joining over. Note they // yield tuples of segments instead of component enumerator which yields a result // object. This way appears to be faster for segment-level iteration. [] type SegmentQuery<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> new(s1) = { s1 = s1 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1>(c.s1) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> new(s1, s2) = { s1 = s1; s2 = s2 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2>(c.s1, c.s2) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> new(s1, s2, s3) = { s1 = s1; s2 = s2; s3 = s3 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2, 's3>(c.s1, c.s2, c.s3) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2> * SD<'s3>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> new(s1, s2, s3, s4) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4>(c.s1, c.s2, c.s3, c.s4) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> new(s1, s2, s3, s4, s5) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5>(c.s1, c.s2, c.s3, c.s4, c.s5) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> new(s1, s2, s3, s4, s5, s6) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5> * SD<'s6>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> val private s7 : Segments<'k, 's7> new(s1, s2, s3, s4, s5, s6, s7) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6; s7 = s7 } member c.GetEnumerator() = new SegmentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6, c.s7) member c.GetComponentCount() = let mutable count = 0 let mutable e = c.GetEnumerator() while e.MoveNext() do count <- count + Bits.bitCount64 e.Mask count interface IEnumerable * SD<'s1> * SD<'s2> * SD<'s3> * SD<'s4> * SD<'s5> * SD<'s6> * SD<'s7>)> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator // ComponentQuery // These are nearly identical to SegmentQuery, but they provide enumeration over Items // instead of segments. [] type ComponentQuery<'k, 's1 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> new(s1) = { s1 = s1 } member c.Segments = SegmentQuery<_,_>(c.s1) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1>(c.s1) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> new(s1, s2) = { s1 = s1; s2 = s2 } member c.Segments = SegmentQuery<_,_,_>(c.s1, c.s2) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2>(c.s1, c.s2) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2, 's3 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> new(s1, s2, s3) = { s1 = s1; s2 = s2; s3 = s3 } member c.Segments = SegmentQuery<_,_,_,_>(c.s1, c.s2, c.s3) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2, 's3>(c.s1, c.s2, c.s3) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2, 's3, 's4 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> new(s1, s2, s3, s4) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4 } member c.Segments = SegmentQuery<_,_,_,_,_>(c.s1, c.s2, c.s3, c.s4) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4>(c.s1, c.s2, c.s3, c.s4) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> new(s1, s2, s3, s4, s5) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5 } member c.Segments = SegmentQuery<_,_,_,_,_,_>(c.s1, c.s2, c.s3, c.s4, c.s5) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5>(c.s1, c.s2, c.s3, c.s4, c.s5) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> new(s1, s2, s3, s4, s5, s6) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6 } member c.Segments = SegmentQuery<_,_,_,_,_,_,_>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator [] type ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7 when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = val private s1 : Segments<'k, 's1> val private s2 : Segments<'k, 's2> val private s3 : Segments<'k, 's3> val private s4 : Segments<'k, 's4> val private s5 : Segments<'k, 's5> val private s6 : Segments<'k, 's6> val private s7 : Segments<'k, 's7> new(s1, s2, s3, s4, s5, s6, s7) = { s1 = s1; s2 = s2; s3 = s3; s4 = s4; s5 = s5; s6 = s6; s7 = s7 } member c.Segments = SegmentQuery<_,_,_,_,_,_,_,_>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6, c.s7) member c.GetEnumerator() = new ComponentQueryEnumerator<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7>(c.s1, c.s2, c.s3, c.s4, c.s5, c.s6, c.s7) member c.GetCount() = c.Segments.GetComponentCount() interface IEnumerable> with member c.GetEnumerator() = c.GetEnumerator() :> IEnumerator<_> member c.GetEnumerator() = c.GetEnumerator() :> Collections.IEnumerator // Extensions [] module QueryExtensions = type ISegmentStore<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> with // Segment queries member c.QuerySegments<'s1>() = SegmentQuery<'k, 's1>( c.GetSegments<'s1>()) member c.QuerySegments<'s1, 's2>() = SegmentQuery<'k, 's1, 's2>( c.GetSegments<'s1>(), c.GetSegments<'s2>()) member c.QuerySegments<'s1, 's2, 's3>() = SegmentQuery<'k, 's1, 's2, 's3>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>()) member c.QuerySegments<'s1, 's2, 's3, 's4>() = SegmentQuery<'k, 's1, 's2, 's3, 's4>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>()) member c.QuerySegments<'s1, 's2, 's3, 's4, 's5>() = SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>()) member c.QuerySegments<'s1, 's2, 's3, 's4, 's5, 's6>() = SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>(), c.GetSegments<'s6>()) member c.QuerySegments<'s1, 's2, 's3, 's4, 's5, 's6, 's7>() = SegmentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>(), c.GetSegments<'s6>(), c.GetSegments<'s7>()) // Component queries member c.Query<'s1>() = ComponentQuery<'k, 's1>( c.GetSegments<'s1>()) member c.Query<'s1, 's2>() = ComponentQuery<'k, 's1, 's2>( c.GetSegments<'s1>(), c.GetSegments<'s2>()) member c.Query<'s1, 's2, 's3>() = ComponentQuery<'k, 's1, 's2, 's3>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>()) member c.Query<'s1, 's2, 's3, 's4>() = ComponentQuery<'k, 's1, 's2, 's3, 's4>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>()) member c.Query<'s1, 's2, 's3, 's4, 's5>() = ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>()) member c.Query<'s1, 's2, 's3, 's4, 's5, 's6>() = ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>(), c.GetSegments<'s6>()) member c.Query<'s1, 's2, 's3, 's4, 's5, 's6, 's7>() = ComponentQuery<'k, 's1, 's2, 's3, 's4, 's5, 's6, 's7>( c.GetSegments<'s1>(), c.GetSegments<'s2>(), c.GetSegments<'s3>(), c.GetSegments<'s4>(), c.GetSegments<'s5>(), c.GetSegments<'s6>(), c.GetSegments<'s7>()) ================================================ FILE: src/Garnet/Registry.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.Runtime.InteropServices open System.Threading open Garnet.Composition.Comparisons type IRegistryHandler<'p> = /// Serves as a callback when iterating over typed instances in registry. /// Takes a custom param, index, and instance abstract member Handle<'a> : 'p * int * 'a byref-> unit /// Provides methods to register and resolve single-instance objects by type type IRegistry = /// Registers a factory for creating values of a specific type abstract member SetFactory<'a> : (unit -> 'a) -> unit /// Adds or replaces a specific instance of a type abstract member Set<'a> : 'a -> unit /// Gets or creates a reference to a typed value abstract member Get<'a> : unit -> 'a byref /// Attempts to resolve a type, returning true if successful abstract member TryGet<'a> : [] value : byref<'a> -> bool /// Iterates over all instances, calling handler for each abstract member Iter<'p> : 'p * IRegistryHandler<'p> -> unit type private IRegistryEntryHandler = abstract member Handle<'p> : 'p * int * IRegistryHandler<'p> -> unit type private RegistryEntryHandler<'a>(instance : 'a ref) = interface IRegistryEntryHandler with member c.Handle<'p>(param : 'p, index, handler) = handler.Handle(param, index, &instance.contents) [] type private RegistryEntry = { Handler : IRegistryEntryHandler Reference : obj } with static member Create<'a>(instance : 'a ref) = { Handler = RegistryEntryHandler<'a>(instance) Reference = instance } type internal RegistryTypeId() = static let mutable id = 0 static member GetNext() = Interlocked.Increment(&id) type internal RegistryTypeId<'a>() = static let mutable id = MessageTypeId.GetNext() static member Id = id /// Provides methods to register and resolve single-instance objects by type type Registry() = let mutable factories = Array.zeroCreate>(8) let mutable lookup = Array.zeroCreate(8) let instances = List() member private c.TryGetReference<'a>([] reference : byref<'a ref>) = let id = RegistryTypeId<'a>.Id if id >= lookup.Length then Buffer.resizeArray (id + 1) &lookup let value = lookup.[id] if isNotNull value then // Value is present already reference <- value :?> 'a ref true elif id < factories.Length && isNotNull factories.[id] then // Use factory to create let factory = factories.[id] let entry = factory.Invoke() lookup.[id] <- entry.Reference instances.Add(entry) reference <- entry.Reference :?> 'a ref true else false member c.SetFactory<'a>(create : unit -> 'a) = let id = RegistryTypeId<'a>.Id if id >= factories.Length then Buffer.resizeArray (id + 1) &factories factories.[id] <- Func<_>(fun () -> // Entry is temporarily marked null to detect cycles if obj.ReferenceEquals(factories.[id], null) then failwithf "Cycle detected for %s" (Format.typeToString typeof<'a>) else // Mark null to detect cycles let factory = factories.[id] factories.[id] <- null // Instantiate type let value = create() let cell = ref value let entry = RegistryEntry.Create(cell) // Restore factory factories.[id] <- factory entry) member c.Set<'a>(newValue : 'a) = let id = RegistryTypeId<'a>.Id if id >= lookup.Length then Buffer.resizeArray (id + 1) &lookup if isNull lookup.[id] then let cell = ref newValue lookup.[id] <- cell :> obj instances.Add(RegistryEntry.Create(cell)) let cell = lookup.[id] :?> 'a ref cell.Value <- newValue member c.Get<'a>() = let mutable cell = Unchecked.defaultof<_> if c.TryGetReference(&cell) then &cell.contents else // No factory, create default value let value = Activator.CreateInstance<'a>() let cell = ref value let id = RegistryTypeId<'a>.Id lookup.[id] <- cell :> obj instances.Add(RegistryEntry.Create(cell)) &cell.contents member c.TryGet<'a>([] value : byref<'a>) = let mutable cell = Unchecked.defaultof<_> let result = c.TryGetReference(&cell) if result then value <- cell.contents result member c.Iter(param, handler) = c.Iter(param, handler, 0) member c.Iter(param, handler : IRegistryHandler<'p>, offset) = for i = 0 to instances.Count - 1 do instances.[i].Handler.Handle(param, offset + i, handler) interface IRegistry with member c.SetFactory(x) = c.SetFactory(x) member c.Set(x) = c.Set(x) member c.Get<'a>() = &c.Get<'a>() member c.TryGet<'a>([] value) = c.TryGet<'a>(&value) member c.Iter(param, handler) = c.Iter(param, handler) member c.ToString(writer : IStringBlockWriter) = if writer.BeginList("Types", instances.Count) then let sorted = instances |> Seq.sortBy (fun x -> x.Reference.GetType().Name) for item in sorted do writer.Write(item.Reference.ToString().Replace("\n", "\n ")) writer.End() override c.ToString() = StringBlockWriter.Format(c.ToString) type private CopyRegistryHandler() = interface IRegistryHandler with member c.Handle<'a>(registry, _, instance : 'a byref) = registry.Set<'a>(instance) [] module Registry = type IRegistry with member c.CopyTo(dest : IRegistry) = let handler = CopyRegistryHandler() c.Iter(dest, handler) member c.GetOrDefault<'a>(fallback : 'a) = match c.TryGet<'a>() with | true, x -> x | false, _ -> fallback member c.GetOrDefault<'a>() = c.GetOrDefault(Unchecked.defaultof<'a>) member c.GetOrSetDefault<'a>(fallback : 'a) = match c.TryGet<'a>() with | true, value -> value | false, _ -> c.Set(fallback); fallback ================================================ FILE: src/Garnet/Resources.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.IO open System.IO.Compression open System.Runtime.InteropServices open System.Threading type IStreamSource = abstract TryOpen : string -> ValueOption type IReadOnlyFolder = inherit IStreamSource inherit IDisposable abstract GetFiles : string * string -> string seq abstract Contains : string -> bool abstract FlushChanged : Action -> unit type IFolder = inherit IReadOnlyFolder abstract OpenWrite : string -> Stream module private ResourcePath = let getCanonical (path : string) = path.Replace('\\', '/').ToLowerInvariant() /// Result has front slashes let getRelativePath (dir : string) (file : string) = try let pathUri = Uri(getCanonical file) let dir = getCanonical dir let dirWithSlash = if dir.EndsWith("/") then dir else dir + "/" let dirUri = Uri(dirWithSlash); Uri.UnescapeDataString(dirUri.MakeRelativeUri(pathUri).ToString()) with ex -> raise(Exception($"Could not get relative path in directory '%s{dir}' for file '%s{file}'", ex)) let getExtensions (path : string) = seq { let file = Path.GetFileName(path) let mutable start = file.IndexOf('.') while start >= 0 do yield file.Substring(start) start <- file.IndexOf('.', start + 1) } /// Thread-safe type private ResourceInvalidationSet() = let changedSet = Dictionary() let flushed = List<_>() let sync = obj() member c.Invalidate(key, timestamp) = Monitor.Enter sync changedSet.[key] <- timestamp Monitor.Exit sync member c.FlushChanged(maxTimestamp, action : Action) = Monitor.Enter sync for kvp in changedSet do if kvp.Value < maxTimestamp then flushed.Add kvp.Key for key in flushed do action.Invoke key changedSet.Remove key |> ignore flushed.Clear() Monitor.Exit sync type ZipArchiveFolder(archive : ZipArchive) = let lookup = let d = Dictionary() for entry in archive.Entries do d.Add(ResourcePath.getCanonical entry.FullName, entry) d new(file : string) = new ZipArchiveFolder(ZipFile.OpenRead(file)) member c.GetFiles(dir : string, _) = lookup.Keys |> Seq.filter (fun name -> name.StartsWith(dir)) member c.Contains(file) = lookup.ContainsKey(file) member c.TryOpen(file) = match lookup.TryGetValue(file) with | true, entry -> ValueSome (entry.Open()) | false, _ -> ValueNone member c.Dispose() = archive.Dispose() interface IReadOnlyFolder with member c.GetFiles(dir, searchPattern) = c.GetFiles(dir, searchPattern) member c.Contains(file) = c.Contains(file) member c.TryOpen(file) = c.TryOpen(file) member c.FlushChanged _ = () interface IDisposable with member c.Dispose() = c.Dispose() /// Thread-safe type FileFolder(rootDir, delay) = let rootDir = let path = if String.IsNullOrEmpty(rootDir) then Directory.GetCurrentDirectory() else rootDir Path.GetFullPath(path) let changedSet = ResourceInvalidationSet() let handler = FileSystemEventHandler(fun s e -> let path = ResourcePath.getRelativePath rootDir e.FullPath //log <| sprintf "'%s' %A" path e.ChangeType changedSet.Invalidate(path, DateTime.UtcNow)) let disposeWatcher = if delay = Int32.MaxValue then ignore else Directory.CreateDirectory(rootDir) |> ignore let watcher = new FileSystemWatcher( Path = rootDir, NotifyFilter = NotifyFilters.LastWrite, Filter = "*.*", IncludeSubdirectories = true, EnableRaisingEvents = true) watcher.add_Changed handler watcher.add_Created handler watcher.Dispose let rec openFile path (delay : int) retryCount = try File.Open(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) with ex -> if retryCount = 0 then raise ex else Thread.Sleep delay openFile path (delay * 2) (retryCount - 1) let getFullPath (file : string) = if Path.IsPathRooted(file) then file else Path.Combine(rootDir, file) new(rootDir) = new FileFolder(rootDir, Int32.MaxValue) new() = new FileFolder("") member c.GetFiles(dir, searchPattern) = let subDir = Path.Combine(rootDir, dir) if Directory.Exists subDir then Directory.EnumerateFiles(subDir, searchPattern) |> Seq.map (fun file -> let fullPath = Path.GetFullPath file ResourcePath.getRelativePath rootDir fullPath) else Seq.empty member c.Contains(file) = let path = getFullPath file File.Exists(path) member c.TryOpen(file) = let path = getFullPath file if File.Exists(path) then ValueSome (openFile path 1 5 :> Stream) else ValueNone member c.OpenWrite(file) = let path = getFullPath file let dir = Path.GetDirectoryName path Directory.CreateDirectory dir |> ignore File.Open(path, FileMode.Create) :> Stream member c.FlushChanged(action : Action) = let maxTimestamp = DateTime.UtcNow - TimeSpan.FromMilliseconds(float delay) changedSet.FlushChanged(maxTimestamp, action) member c.Dispose() = disposeWatcher() interface IFolder with member c.GetFiles(dir, searchPattern) = c.GetFiles(dir, searchPattern) member c.Contains(file) = c.Contains(file) member c.TryOpen(file) = c.TryOpen(file) member c.OpenWrite(file) = c.OpenWrite(file) member c.FlushChanged(action) = c.FlushChanged(action) member c.Dispose() = c.Dispose() override c.ToString() = rootDir /// Note Dispose() is absent type NonDisposingStream(stream : Stream, onClose) = inherit Stream() override c.Position with get() = stream.Position and set value = stream.Position <- value override c.CanRead = stream.CanRead override c.CanWrite = stream.CanWrite override c.CanSeek = stream.CanSeek override c.Length = stream.Length override c.Write(input, offset, count) = stream.Write(input, offset, count) override c.Read(output, offset, count) = stream.Read(output, offset, count) override c.Flush() = stream.Flush() override c.Seek(offset, origin) = stream.Seek(offset, origin) override c.SetLength(length) = stream.SetLength(length) override c.Close() = onClose() /// Stream lookup is thread-safe, but reading/writing is not type MemoryStreamLookup<'k when 'k : equality>() = let updated = List<'k>() let streams = Dictionary<'k, MemoryStream>() let sync = obj() member c.OpenWrite (id : 'k) = let ms = lock sync <| fun () -> match streams.TryGetValue id with | true, x -> x | false, _ -> let ms = new MemoryStream() streams.Add(id, ms) ms new NonDisposingStream(ms, fun () -> updated.Add id) :> Stream member c.GetKeys() = lock sync <| fun () -> streams.Keys |> Seq.toArray :> seq<_> member c.Contains(key) = lock sync <| fun () -> streams.ContainsKey(key) member c.TryOpen(id) = lock sync <| fun () -> match streams.TryGetValue id with | true, x -> ValueSome x | false, _ -> ValueNone |> ValueOption.map (fun ms -> let length = int ms.Length let buffer = ms.GetBuffer() new MemoryStream(buffer, 0, length, false) :> Stream) member c.FlushChanged (action : Action<'k>) = let count = updated.Count for i = 0 to count - 1 do let key = updated.[i] action.Invoke(key) updated.RemoveRange(0, count) override c.ToString() = $"Streams (%d{streams.Count}):\n" + String.Join("\n", streams |> Seq.map (fun kvp -> $"%A{kvp.Key}: %d{kvp.Value.Length}")) type MemoryFolder() = let lookup = MemoryStreamLookup() interface IFolder with member c.GetFiles(_, _) = lookup.GetKeys() member c.Contains(file) = lookup.Contains(file) member c.TryOpen(file) = lookup.TryOpen(file) member c.OpenWrite(file) = lookup.OpenWrite(file) member c.FlushChanged _ = () member c.Dispose() = () override c.ToString() = lookup.ToString() [] module FileFolder = type IStreamSource with member c.Open(key) = match c.TryOpen(key) with | ValueNone -> failwithf $"Could not open %s{key}" | ValueSome x -> x type IReadOnlyFolder with member c.GetFiles(dir) = c.GetFiles(dir, "*.*") member c.GetFiles() = c.GetFiles(".", "*.*") type IResourceCache = abstract TryGetResource<'a> : string * [] value : byref<'a> -> bool abstract LoadResource<'a> : string -> 'a abstract AddResource<'a> : string * 'a -> unit type IResourceLoader = abstract Load : IReadOnlyFolder * IResourceCache * string -> unit type private ResourceTypeId() = static let mutable id = 0 static member GetNext() = Interlocked.Increment(&id) type private ResourceTypeId<'a>() = static let mutable id = ResourceTypeId.GetNext() static member Id = id type ResourceCache(folder : IReadOnlyFolder) = let mutable caches = Array.zeroCreate(8) let mutable folder = folder let disposables = List() let loaders = Dictionary() new() = new ResourceCache(new MemoryFolder()) member private c.GetResources<'a>() = let id = ResourceTypeId<'a>.Id if id >= caches.Length then Buffer.resizeArray (id + 1) &caches let cache = caches.[id] if Comparisons.isNotNull cache then cache :?> Dictionary else let cache = Dictionary() caches.[id] <- cache :> obj cache member private c.TryLoad(key) = let extensions = ResourcePath.getExtensions key let mutable loaded = false let mutable e = extensions.GetEnumerator() while not loaded && e.MoveNext() do match loaders.TryGetValue(e.Current) with | true, loader -> loader.Load(folder, c, key) loaded <- true | false, _ -> () loaded member c.SetFolder(newFolder) = folder <- newFolder member c.AddLoader(extension, typeLoader) = loaders.[extension] <- typeLoader member c.AddResource(key, resource) = let key = ResourcePath.getCanonical key c.GetResources().[key] <- resource match resource :> obj with | :? IDisposable as disposable -> disposables.Add(disposable) | _ -> () member c.TryGetResource<'a>(key, [] value : byref<'a>) = let canonicalKey = ResourcePath.getCanonical key let cache = c.GetResources<'a>() cache.TryGetValue(canonicalKey, &value) member c.LoadResource<'a> key = let canonicalKey = ResourcePath.getCanonical key let cache = c.GetResources<'a>() match cache.TryGetValue(canonicalKey) with | true, resource -> resource | false, _ -> if not (c.TryLoad(canonicalKey)) then let str = String.Join("\n", loaders.Keys) failwith $"No loader for {key}, available:\n{str}" match cache.TryGetValue(canonicalKey) with | true, resource -> resource | false, _ -> failwith $"{key} was not loaded" member c.LoadAll(path) = for file in folder.GetFiles(path) do c.TryLoad(file) |> ignore member c.Dispose() = for disposable in disposables do disposable.Dispose() interface IResourceCache with member c.TryGetResource<'a>(key, [] value : byref<'a>) = c.TryGetResource<'a>(key, &value) member c.LoadResource<'a> key = c.LoadResource<'a>(key) member c.AddResource(key, resource) = c.AddResource(key, resource) interface IDisposable with member c.Dispose() = c.Dispose() ================================================ FILE: src/Garnet/Segments.fs ================================================ namespace Garnet.Composition open System open System.Collections.Generic open System.Text open System.Runtime.InteropServices open System.Threading open Garnet.Composition.Comparisons module Segment = [] let SegmentBits = 6 [] let SegmentSize = 64 [] let SegmentMask = 0b111111 /// Contiguous 64-element segment with a mask indicating which elements /// are defined and ID to identify the segment in a sparse collection [] type Segment<'k, 'a when 'k :> IComparable<'k>> = val Id : 'k val Mask : uint64 val Data : 'a[] new(id, mask, data) = { Id = id; Mask = mask; Data = data } override s.ToString() = sprintf "%s %s" (s.Id.ToString()) (Format.maskToString 64 s.Mask) member c.GetOrDefault(i, fallback) = if c.Mask &&& (1UL <<< i) <> 0UL then c.Data.[i] else fallback /// 64-bit mask and ID to identify the segment in a sparse collection [] type internal BitSegment<'k when 'k :> IComparable<'k>> = val Id : 'k val Mask : uint64 new(id, mask) = { Id = id; Mask = mask } override s.ToString() = sprintf "%s %s" (s.Id.ToString()) (Format.maskToString 64 s.Mask) /// Provides a method for accepting a generically-typed segment type ISegmentHandler<'p, 'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = abstract member Handle<'a> : 'p * Segment<'k, 'a> -> unit type ISegmentListHandler<'p, 'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = abstract member Handle<'a> : 'p * ReadOnlyMemory> -> unit type PrintHandler<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>(mask) = let sb = StringBuilder() let mutable bytes = 0 let iter action param mask (sa : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param sa.[i] m <- m >>> 1 i <- i + 1 member private c.Print<'a, 'b> (_ : 'a) (x : 'b) = let t = typeof<'b> sb.AppendLine() |> ignore sb.Append(t.Name) |> ignore if not (Format.isEmptyType t) then bytes <- bytes + sizeof<'b> sb.Append(sprintf " %A" x) |> ignore interface ISegmentHandler with member c.Handle((), segment) = iter c.Print () (segment.Mask &&& mask) segment.Data interface ISegmentListHandler with member c.Handle((), segments) = for segment in segments.Span do iter c.Print () (segment.Mask &&& mask) segment.Data override c.ToString() = sprintf "%d bytes" bytes + sb.ToString() [] module internal Internal = type ISegments<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = abstract member Clear : unit -> unit abstract member TryFind : 'k * byref -> bool abstract member Remove : 'k * uint64 -> unit abstract member Commit : unit -> unit abstract member Handle<'p> : 'p * ISegmentListHandler<'p, 'k> ->unit abstract member Handle<'p> : 'p * ISegmentHandler<'p, 'k> * 'k * uint64 ->unit let failComponentOperation op mask conflict (s : Segment<_, 'a>) = failwithf "Could not %s %s, sid: %A\n Requested: %s\n Existing: %s\n Error: %s" op (typeof<'a> |> Format.typeToString) s.Id (Format.maskToString 64 mask) (Format.maskToString 64 s.Mask) (Format.maskToString 64 conflict) [] type PendingSegment<'k, 'a when 'k :> IComparable<'k>> = { Data : 'a[] Id : 'k mutable Mask : uint64 mutable RemovalMask : uint64 } /// Ordered list of segments and lookup type CurrentSegments<'k, 'a when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>(pool : Stack<'a[]>) = let mutable segments = Array.zeroCreate> 8 let mutable count = 0 let idToIndex = DictionarySlim<'k, int>() member internal c.ComponentCount = let mutable total = 0 for i = 0 to count - 1 do let seg = segments.[i] total <- total + Bits.bitCount64 seg.Mask total member c.Components = seq { for i = 0 to count - 1 do let seg = segments.[i] let mutable m = seg.Mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then yield seg.Data.[i] m <- m >>> 1 i <- i + 1 } member c.Segments = ReadOnlyMemory(segments).Slice(0, count) member c.Count = count /// Takes segment index, not ID member c.Item with get i = segments.[i] member c.Clear() = for i = 0 to count - 1 do let seg = segments.[i] Buffer.clearArrayMask seg.Mask seg.Data pool.Push(seg.Data) Array.Clear(segments, 0, count) count <- 0 idToIndex.Clear() member c.Handle<'p>(param, handler : ISegmentListHandler<'p, 'k>) = handler.Handle(param, c.Segments) /// Given a segment ID, returns segment index if found or -1 if not found member c.TryFind(id, [] i : byref<_>) = idToIndex.TryGetValue(id, &i) /// Change value of components which are already present member c.Set(i, mask) = let s = segments.[i] let newMask = s.Mask ||| mask let diff = s.Mask ^^^ newMask if diff <> 0UL then failComponentOperation "set" mask (mask &&& ~~~s.Mask) s s.Data member c.Add(i, mask) = let s = segments.[i] let newMask = s.Mask ||| mask segments.[i] <- Segment(s.Id, newMask, s.Data) s.Data member c.Remove(i, mask) = let s = segments.[i] let newMask = s.Mask &&& ~~~mask segments.[i] <- Segment(s.Id, newMask, s.Data) s.Data /// Input must be new sorted segments member c.MergeFrom(src : PendingSegment<'k, 'a>[], srcCount) = // add new segments let hasAdded = srcCount > 0 if hasAdded then // allocate space first let origCount = count count <- count + srcCount Buffer.resizeArray count &segments let a = segments let b = src let mutable k = count - 1 let mutable j = srcCount - 1 let mutable i = origCount - 1 while k >= 0 do a.[k] <- if j < 0 || (i >= 0 && (a.[i].Id.CompareTo(b.[j].Id) >= 0)) then let x = a.[i] i <- i - 1 x else let x = b.[j] j <- j - 1 Segment(x.Id, x.Mask, x.Data) k <- k - 1 // remove any empty segments let mutable iDest = 0 for iSrc = 0 to count - 1 do let seg = segments.[iSrc] if seg.Mask = 0UL then pool.Push(seg.Data) else segments.[iDest] <- seg iDest <- iDest + 1 let hasRemoved = iDest < count if hasRemoved then Array.Clear(segments, iDest, count - iDest) count <- iDest // rebuild lookup if hasAdded || hasRemoved then idToIndex.Clear() for i = 0 to count - 1 do let seg = segments.[i] let index = &idToIndex.GetOrAddValueRef(&seg.Id) index <- i type PendingSegments<'k, 'a when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>(pool : Stack<_>) = let comparison = Comparison>(fun a b -> a.Id.CompareTo(b.Id)) let comparer = Comparer.Create comparison let allocateData = // if no members, assume type has a single state and use single array // in this case, only bits will be stored let t = typeof<'a> if Format.isEmptyType t then let data = Array.zeroCreate(Segment.SegmentSize) fun () -> data else fun () -> if pool.Count > 0 then pool.Pop() else Array.zeroCreate(Segment.SegmentSize) let mutable segments = Array.zeroCreate> 8 let mutable count = 0 let idToIndex = DictionarySlim<'k, int>() member c.Clear() = for i = 0 to count - 1 do let seg = segments.[i] Buffer.clearArray seg.Data pool.Push(seg.Data) count <- 0 idToIndex.Clear() member c.Item with get i = segments.[i] member internal c.Count = count member internal c.Segments = seq { for i = 0 to count - 1 do yield c.[i] } member c.GetMask(id) = match idToIndex.TryGetValue(id) with | true, i -> segments.[i].Mask | false, _ -> 0UL member c.Add(id, mask) = match idToIndex.TryGetValue(id) with | true, i -> let s = &segments.[i] s.Mask <- s.Mask ||| mask s.RemovalMask <- s.RemovalMask &&& ~~~mask s.Data | false, _ -> let i = count if count = segments.Length then segments <- Buffer.expandArray (count + 1) segments let data = allocateData() segments.[i] <- { Id = id Mask = mask Data = data RemovalMask = 0UL } count <- count + 1 let index = &idToIndex.GetOrAddValueRef(&id) index <- i data /// Removes bits given ID, but does not remove segment if empty member c.Remove(id, mask) = match idToIndex.TryGetValue(id) with | true, i -> let s = &segments.[i] s.Mask <- s.Mask &&& ~~~mask s.RemovalMask <- s.RemovalMask ||| mask | false, _ -> let i = count if count = segments.Length then segments <- Buffer.expandArray (count + 1) segments let data = allocateData() segments.[i] <- { Id = id Mask = 0UL Data = data RemovalMask = mask } count <- count + 1 let index = &idToIndex.GetOrAddValueRef(&id) index <- i member c.ApplyRemovalsTo(target : ISegments<_>) = // copy in case this is called on self let count = count for i = 0 to count - 1 do let delta = segments.[i] if delta.RemovalMask <> 0UL then target.Remove(delta.Id, delta.RemovalMask) member c.FlushTo(target : CurrentSegments<'k, 'a>) = if count > 0 then // first copy into existing, removing deltas let mutable di = 0 while di < count do let delta = segments.[di] // if not found, skip past for now match target.TryFind(delta.Id) with | false, _ -> di <- di + 1 | true, i -> // apply removal if delta.RemovalMask <> 0UL then let data = target.Remove(i, delta.RemovalMask) Buffer.clearArrayMask delta.RemovalMask data // apply addition if delta.Mask <> 0UL then // copy into existing let data = target.Add(i, delta.Mask) Buffer.copyArrayMask delta.Mask delta.Data data Buffer.clearArrayMask delta.Mask delta.Data // remove from deltas Array.Clear(delta.Data, 0, delta.Data.Length) pool.Push(delta.Data) count <- count - 1 segments.[di] <- segments.[count] segments.[count] <- Unchecked.defaultof<_> // remaining are all new segments Array.Sort(segments, 0, count, comparer) target.MergeFrom(segments, count) // clear without recycling to pool since we passed ownership Array.Clear(segments, 0, count) count <- 0 idToIndex.Clear() member c.ToString(formatSegments, formatBitSegments) = let additions = segments |> Seq.filter (fun s -> s.Mask <> 0UL) |> Seq.map (fun s -> Segment(s.Id, s.Mask, s.Data)) |> Seq.toArray let removals = segments |> Seq.filter (fun s -> s.RemovalMask <> 0UL) |> Seq.map (fun s -> BitSegment(s.Id, s.RemovalMask)) |> Seq.toArray sprintf "%d/%dA %d/%dR%s%s" (additions |> Seq.sumBy (fun s -> Bits.bitCount64 s.Mask)) additions.Length (removals |> Seq.sumBy (fun s -> Bits.bitCount64 s.Mask)) removals.Length (formatSegments " A" (ReadOnlyMemory(additions))) (formatBitSegments " R" (ReadOnlyMemory(removals))) override c.ToString() = c.ToString(Format.formatIndexedList, Format.formatIndexedList) /// Sparse list of segments type Segments<'k, 'a when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>() = let pool = Stack<_>() let pending = PendingSegments<'k, 'a>(pool) let current = CurrentSegments<'k, 'a>(pool) member internal c.PendingCount = pending.Count member internal c.GetPending i = pending.[i] /// Returns a sequence of the components present member internal c.Components = current.Components member c.GetSpan() = current.Segments.Span member c.GetMemory() = current.Segments /// Number of current segments member c.Count = current.Count /// Takes segment index, not ID member c.Item with get i = current.[i] /// Returns the number of current components stored member c.GetComponentCount() = let mutable total = 0 for i = 0 to c.Count - 1 do total <- total + Bits.bitCount64 c.[i].Mask total /// Given a segment ID, returns true if the segment is present and assigns its index member c.TryFind(sid, [] i : byref<_>) = current.TryFind(sid, &i) /// Immediately clears all current and pending data member c.Clear() = pending.Clear() current.Clear() /// Sets mask for a segment ID member c.Set(sid, mask) = match c.TryFind(sid) with | true, i -> current.Set(i, mask) | false, _ -> failwithf "Segment %A not present" sid /// Returns segment so data can be filled /// Assume either not present or in removal list member c.Add(sid, mask) = pending.Add(sid, mask) /// Assumes present, not considering addition list member c.Remove(sid, mask) = pending.Remove(sid, mask) /// Commits any pending changes and removes empty segments member c.Commit() = pending.FlushTo(current) member internal c.ApplyRemovalsTo segments = if not (obj.ReferenceEquals(c, segments)) then pending.ApplyRemovalsTo segments interface ISegments<'k> with member c.Clear() = c.Clear() member c.TryFind(sid, [] i : byref<_>) = current.TryFind(sid, &i) member c.Remove(sid, mask) = c.Remove(sid, mask) member c.Commit() = c.Commit() member c.Handle<'p>(param, handler : ISegmentListHandler<'p, 'k>) = current.Handle(param, handler) member c.Handle(param, handler, sid, mask) = match c.TryFind(sid) with | false, _ -> () | true, si -> let seg = current.[si] let masked = Segment(seg.Id, seg.Mask &&& mask, seg.Data) handler.Handle(param, masked) member internal c.ToString(formatSegments, formatBitSegments) = let prefix = "" let pendingStr = pending.ToString(formatSegments, formatBitSegments) sprintf "%s: %d/%dC %s%s" (typeof<'a> |> Format.typeToString) current.ComponentCount current.Count (formatSegments (prefix + " C") current.Segments) (if pendingStr.Length > 0 then "\n" + pendingStr else "") override c.ToString() = c.ToString(Format.formatIndexedList, Format.formatIndexedList) type Segments<'k, 'a when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> with /// Returns mask if present, zero otherwise member c.GetMask sid = match c.TryFind(sid) with | true, i -> c.[i].Mask | false, _ -> 0UL member c.Contains(sid) = let mutable i = 0 c.TryFind(sid, &i) member c.Get(sid) = match c.TryFind(sid) with | true, si -> c.[si] | false, _ -> failwithf "Cannot get %s segment %A" (Format.typeToString typeof<'a>) sid /// Removes entire segment member c.Remove(sid) = match c.TryFind(sid) with | false, _ -> () | true, si -> let mask = c.[si].Mask c.Remove(sid, mask) /// Marks all segments for removal, which is different than immediate Clear() member c.RemoveAll() = for i = 0 to c.Count - 1 do let seg = c.[i] c.Remove(seg.Id, seg.Mask) member c.GetSegmentOrEmpty(sid) = match c.TryFind(sid) with | true, i -> c.[i] | false, _ -> Segment(sid, 0UL, null) /// Given a segment ID, returns segment index if found or -1 if not found member c.Find(sid) = match c.TryFind(sid) with | true, i -> i | false, _ -> -1 type ISegmentStore<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> = abstract member GetSegments<'b> : unit -> Segments<'k, 'b> abstract member Handle<'p> : 'p * ISegmentListHandler<'p, 'k> -> unit abstract member Handle<'p> : 'p * 'k * uint64 * ISegmentHandler<'p, 'k> -> unit type CopyHandler<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>() = static let mutable instance = CopyHandler<'k>() static member Instance = instance interface ISegmentHandler, 'k> with member c.Handle<'a>(store, segment : Segment<'k, 'a>) = let dest = store.GetSegments<'a>() let data = dest.Add(segment.Id, segment.Mask) segment.Data.CopyTo(data, 0) interface ISegmentListHandler, 'k> with member c.Handle<'a>(store, src : ReadOnlyMemory>) = let dest = store.GetSegments<'a>() for seg in src.Span do let data = dest.Add(seg.Id, seg.Mask) seg.Data.CopyTo(data, 0) type internal ComponentTypeId() = static let mutable id = 0 static member GetNext() = Interlocked.Increment(&id) type internal ComponentTypeId<'a>() = static let mutable id = ComponentTypeId.GetNext() static member Id = id type SegmentStore<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality>() = let segmentLists = List>() let mutable lookup = Array.zeroCreate>(8) member c.GetSegments<'a>() = let id = ComponentTypeId<'a>.Id if id >= lookup.Length then Buffer.resizeArray (id + 1) &lookup let segs = lookup.[id] if isNotNull segs then segs :?> Segments<'k, 'a> else let segs = Segments<'k, 'a>() lookup.[id] <- segs :> ISegments<'k> segmentLists.Add(segs) segs member c.Clear() = for segs in segmentLists do segs.Clear() member c.Remove(sid, mask) = for segs in segmentLists do segs.Remove(sid, mask) member c.Handle(param, handler : ISegmentListHandler<_,_>) = for s in segmentLists do s.Handle(param, handler) member c.Handle(param, sid, mask, handler : ISegmentHandler<_,_>) = for s in segmentLists do s.Handle(param, handler, sid, mask) member c.Commit() = for segs in segmentLists do segs.Commit() member c.ApplyRemovalsFrom (segments : Segments<_,_>) = if segments.PendingCount > 0 then for segs in segmentLists do segments.ApplyRemovalsTo(segs) interface ISegmentStore<'k> with member c.Handle(param, handler : ISegmentListHandler<_,_>) = c.Handle(param, handler) member c.Handle(param, sid, mask, handler : ISegmentHandler<_,_>) = c.Handle(param, sid, mask, handler) member c.GetSegments<'a>() = c.GetSegments<'a>() override c.ToString() = let prefix = "" segmentLists |> Seq.map (fun item -> item.ToString().Replace("\n", "\n ")) |> Format.listToString (prefix + " ") (c.GetType() |> Format.typeToString) [] module SegmentStore = type ISegmentStore<'k when 'k :> IComparable<'k> and 'k :> IEquatable<'k> and 'k : equality> with member c.CopyTo(dest : ISegmentStore<'k>) = let handler = CopyHandler.Instance :> ISegmentListHandler<_,_> c.Handle(dest, handler) member c.CopyTo(dest : ISegmentStore<'k>, sid, mask) = let handler = CopyHandler.Instance :> ISegmentHandler<_,_> c.Handle(dest, sid, mask, handler) ================================================ FILE: tests/Garnet.Tests/ActorTests.fs ================================================ module Garnet.Tests.Actors open System open System.Collections.Generic open System.IO open System.Threading open Expecto open Garnet.Composition open Garnet.Streaming type Run = struct end type Ping = struct end type Pong = struct end type Inbox() = let dict = Dictionary() member c.OnAll<'a>(action : Message<'a> -> unit) = let t = typeof<'a> let combined = match dict.TryGetValue t with | false, _ -> action | true, existing -> let existing = existing :?> (Message<'a> -> unit) fun e -> existing e action e dict.[t] <- combined member c.TryReceive<'a> e = match dict.TryGetValue(typeof<'a>) with | true, x -> let handle = x :?> (Message<'a> -> unit) handle e true | false, _ -> false interface IInbox with member c.Receive(outbox, message) = c.TryReceive(message) |> ignore let bgDispatcherId = 0 let mainDispatcherId = 1 let runPingPong onPing onPong iterations = let mutable count = 0 use a = new ActorSystem(0) a.Register(ActorId 1, fun _ -> let h = Mailbox() h.On <| fun e -> h.Send(ActorId 2, Ping()) h.On <| fun e -> count <- count + 1 if count < iterations then onPing(e) h.Respond(Ping()) Actor(h)) a.Register(ActorId 2, fun _ -> let h = Mailbox() h.On <| fun e -> onPong e h.Respond(Pong()) Actor(h)) a.Process(ActorId 1, Run()) a.ProcessAll() count let sendReceiveMessages send = let results = List<_>() use a = new ActorSystem(0) let h = Inbox() h.OnAll <| fun msg -> results.Add { Buffer = ReadOnlySpan(msg.Buffer, 0, msg.Count).ToArray() Pool = null Count = msg.Count SourceId = msg.SourceId DestinationId = msg.DestinationId } a.Register(ActorId 1, fun _ -> Actor(h)) send (a.Get(ActorId 1)) a.ProcessAll() results |> List.ofSeq [] let tests = testList "actors" [ testCase "send to undefined actor" <| fun () -> use a = new ActorSystem() a.Send(ActorId 1, 10) a.ProcessAll() testCase "send batch" <| fun () -> let results = sendReceiveMessages <| fun a -> a.SendAll(ReadOnlyMemory([| 1; 2; 3 |]).Span) let r = List.head results r.SourceId |> shouldEqual (ActorId 0) r.DestinationId |> shouldEqual (ActorId 1) r.Buffer |> shouldEqual [| 1; 2; 3 |] testCase "send single" <| fun () -> let results = sendReceiveMessages <| fun a -> a.Send(1) let r = List.head results r.SourceId |> shouldEqual (ActorId 0) r.DestinationId |> shouldEqual (ActorId 1) r.Buffer |> shouldEqual [| 1 |] testCase "send single with source" <| fun () -> let results = sendReceiveMessages <| fun a -> a.Send(1, sourceId = ActorId 2) let r = List.head results r.SourceId |> shouldEqual (ActorId 2) r.DestinationId |> shouldEqual (ActorId 1) r.Buffer |> shouldEqual [| 1 |] testCase "send to any actor" <| fun () -> let msgs = List<_>() let inbox = Mailbox() inbox.On msgs.Add use a = new ActorSystem() a.Register(fun id -> Actor(inbox)) a.Send(ActorId 1, 10) a.ProcessAll() msgs.Count |> shouldEqual 1 testCase "create ping pong actors" <| fun () -> let iterations = 10 runPingPong ignore ignore iterations |> shouldEqual iterations testCase "send message to self" <| fun () -> let mutable count = 0 use a = new ActorSystem(0) a.Register(ActorId 1, fun _ -> let c = Mailbox() c.On <| fun e -> if e < 10 then count <- count + 1 c.Send(ActorId 1, e + 1) Actor(c, mainDispatcherId)) a.Process(ActorId 1, 0) count |> shouldEqual 10 testCase "send message to other" <| fun () -> let mutable count1 = 0 let mutable count2 = 0 use a = new ActorSystem(0) a.Register(ActorId 1, fun _ -> let c = Mailbox() c.On <| fun e -> if e < 10 then count1 <- count1 + 1 c.Send(ActorId 2, e + 1) Actor(c)) a.Register(ActorId 2, fun _ -> let c = Mailbox() c.On <| fun e -> if e < 10 then count2 <- count2 + 1 c.Send(ActorId 1, e + 1) Actor(c)) a.Process(ActorId 1, 0) count1 |> shouldEqual 5 count2 |> shouldEqual 5 testCase "send message to background actor" <| fun () -> let mutable count1 = 0 let mutable count2 = 0 use a = new ActorSystem(1) a.Register(ActorId 1, fun _ -> let c = Mailbox() c.On <| fun e -> // bg thread should be different Expect.notEqual Thread.CurrentThread.ManagedThreadId e.ManagedThreadId "" c.On <| fun e -> if e < 10 then count1 <- count1 + 1 //printfn "FG: %d" Thread.CurrentThread.ManagedThreadId c.Send(ActorId 2, e + 1) Actor(c, mainDispatcherId)) a.Register(ActorId 2, fun _ -> let c = Mailbox() c.On <| fun e -> if e < 10 then count2 <- count2 + 1 //printfn "BG: %d" Thread.CurrentThread.ManagedThreadId c.Send(ActorId 1, Thread.CurrentThread) c.Send(ActorId 1, e + 1) Actor(c)) a.Process(ActorId 1, 0) a.ProcessAll() count1 |> shouldEqual 5 count2 |> shouldEqual 5 testCase "respond to messages" <| fun () -> let config = { Dispatchers = [| { Name = "" DispatcherType = DispatcherType.Background ThreadCount = 2 Throughput = 100 } |] } use a = new ActorSystem(config) a.Register(ActorFactory.Create(fun _ m -> m.On <| fun e -> //printfn "Responding from %A to %A" m.DestinationId m.SourceId m.Respond(Pong()))) for i = 1 to 10 do a.Send(ActorId i, ActorId (i * 2), Ping()) a.ProcessAll() testCase "send random messages to background actors" <| fun () -> use a = new ActorSystem(2) a.Register(fun (createId : ActorId) -> let rand = Random(createId.Value) let c = Mailbox() c.On <| fun e -> //printfn "%d: %d" id.id e if e < 1000 then let nextId = rand.Next(1, 256) c.Send(ActorId nextId, e + 1) Actor(c)) a.Process(ActorId 1, 123) testCase "actor thread stress test" <| fun () -> let mutable count = 0L let log = MemoryActorStreamSource() let createRegistry() = let r = MessageRegistry() r.Register 1 <| RawSerializer() r.Register 2 <| RawSerializer() r.Register 3 <| RawSerializer() r.Register 4 <| RawSerializer() r.Register 5 <| RawSerializer() r.Register 6 <| RawSerializer() r let start = DateTime.Now let config = { Dispatchers = [| { Name = "" DispatcherType = DispatcherType.Background ThreadCount = 4 Throughput = 100 } |] } use a = new ActorSystem(4) let rules = [ ActorFactory.Create(ActorId 1, fun _ (c : Mailbox) -> c.On <| fun e -> for i = 1 to 1000 do c.Send(ActorId 2, uint32 i) c.Send(ActorId 2, uint16 i)) ActorFactory.Create(ActorId 2, fun _ (c : Mailbox) -> c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 3, uint32 i) c.Send(ActorId 4, uint16 i) c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 3, uint8 i)) ActorFactory.Create(ActorId 3, fun _ (c : Mailbox) -> c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 4, int8 i) c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 4, int8 i) c.On <| fun e -> Interlocked.Increment(&count) |> ignore) ActorFactory.Create(ActorId 4, fun _ (c : Mailbox) -> c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 2, int i) c.On <| fun e -> Interlocked.Increment(&count) |> ignore) ] //|> List.map (ActorFactory.withLogging createRegistry log.OpenWrite) a.Register(rules) for i = 1 to 100 do a.Process(ActorId 1, 0) Thread.Sleep(0) a.ProcessAll() //let duration = DateTime.Now - start // printfn "%s" <| a.ToString() // printfn "%A" <| duration //log.Print { // createMessageRegistry = createRegistry // createFormatter = Formatter // print = ignore // range = MessageRange.count 1000 // filter = ActorLogFilter.all // } testCase "threaded actor logging" <| fun () -> let log = MemoryActorStreamSource() let createRegistry() = let r = MessageRegistry() r.Register 1 <| RawSerializer() r.Register 2 <| RawSerializer() r.Register 3 <| RawSerializer() r.Register 4 <| RawSerializer() r use a = new ActorSystem(4) let rules = [ ActorFactory.Create(ActorId 1, fun _ c -> c.On <| fun e -> for i = 1 to 100 do c.Send(ActorId 2, uint32 i)) ActorFactory.Create(ActorId 2, fun _ c -> c.On <| fun e -> for i = 1 to 1 do c.Send(ActorId 3, uint8 i)) ] //|> List.map (ActorFactory.withLogging createRegistry log.OpenWrite) a.Register(rules) for i = 1 to 100 do a.Process(ActorId 1, 0) Thread.Sleep(0) a.ProcessAll() //log.Print { // createMessageRegistry = createRegistry // createFormatter = Formatter // print = ignore // range = MessageRange.count 1000 // filter = ActorLogFilter.all // } testCase "serialize string" <| fun () -> let s = StringSerializer() :> ISerializer<_> let ms = new MemoryStream() let value = "test" s.Write ms value ms.Position <- 0L let str2 = s.Read ms str2 |> shouldEqual value // testCase "log messages" <| fun () -> // let reg = MessageRegistry() // reg.Register 1 <| RawSerializer() // reg.Register 10 <| RawSerializer() // reg.Register 11 <| StringSerializer() // let ms = new MemoryStream() // use a = new ActorSystem(0) // let id1 = ActorId 15 // let id2 = ActorId 25 // a.Register [ // ActorFactory.Create(id1, fun _ -> // let h = Mailbox() // h.On <| fun e -> // h.Send(id2, "msg" + e.ToString()) // Actor(LogInbox(id1, h, StreamInbox(reg, ms)))) // ] // a.Process(id1, 100) // ms.Position <- 0L // use a2 = new ActorSystem(0) // a2.Register <| ActorFactory.Create(fun id -> // Actor(PrintInbox(id, Formatter(), ref 0, ignore))) // a2.Process(id1, { enableActorLog = true }) // a2.Process(id2, { enableActorLog = true }) // let sender = StreamMessageSender(reg, fun h -> true) // sender.SendAll(ms, a2) // a2.ProcessAll() ] ================================================ FILE: tests/Garnet.Tests/Assertions.fs ================================================ namespace Garnet.Tests open Expecto [] module Assertions = let shouldEqual b a = Expect.equal a b "" let shouldNotEqual b a = Expect.notEqual a b "" ================================================ FILE: tests/Garnet.Tests/Benchmarks/ActorBenchmarks.fs ================================================ module Garnet.Benchmarks.Actors open System.Collections.Generic open System.Diagnostics open System.Runtime.InteropServices open System.Threading open Garnet.Composition module PingPong = type RecordedMessage = { sourceId : ActorId destId : ActorId sequence : int payload : int64 dispatcher : string timestamp : int64 } module RecordedMessage = let formatPair (s, r) = $"%d{r.payload} from [%d{s.sequence}] a%d{s.sourceId.Value} (d%s{s.dispatcher}) to [%d{r.sequence}] a%d{r.destId.Value} (d%s{r.dispatcher}) in %d{r.timestamp - s.timestamp}" type SynchronizedQueue<'a>() = let incoming = Queue<'a>() let sync = obj() member c.Enqueue x = Monitor.Enter sync incoming.Enqueue x Monitor.Exit sync member c.TryDequeue([] item : byref<_>) = Monitor.Enter sync let r = incoming.Count > 0 if r then item <- incoming.Dequeue() Monitor.Exit sync r member c.Flush() = seq { let mutable item = Unchecked.defaultof<'a> while c.TryDequeue(&item) do yield item } module Tests = let runLogging log onSend onReceive poolCount actorsPerPool workerCount duration initCount maxCount batchSize = let actorCount = actorsPerPool * poolCount let receivedCount = ref 0 let sentCount = ref 0 let config = { Dispatchers = [| for i = 1 to poolCount do yield { // workers Name = $"Worker{i}" ThreadCount = workerCount Throughput = 100 DispatcherType = DispatcherType.Background } yield { // main Name = "Main" DispatcherType = DispatcherType.Foreground ThreadCount = 0 Throughput = 100 } |] } use a = new ActorSystem(config) a.Register(fun (actorId : ActorId) -> let writer = new MessageWriter<_>() let mailbox = Mailbox() mailbox.OnAll <| fun e -> let span = e.Span let c = Interlocked.Increment receivedCount if log then onReceive { sourceId = ActorId.Undefined destId = actorId sequence = c payload = span.[0] timestamp = Stopwatch.GetTimestamp() dispatcher = mailbox.ToString() } if c <= maxCount then let _ = Interlocked.Increment sentCount let rand = uint64 c * 2862933555777941757UL + 3037000493UL let destId = (abs (int rand) % actorCount) + 1 |> ActorId if duration > 0 then Thread.Sleep duration if log then let nextItem = span.[0] + 1L onSend { sourceId = actorId destId = destId sequence = c payload = nextItem timestamp = Stopwatch.GetTimestamp() dispatcher = mailbox.ToString() } for i = 0 to span.Length - 1 do writer.WriteValue(span.[i] + 1L) writer.DestinationId <- destId writer.Outbox <- mailbox writer.Send() let dispatcherId = (actorId.Value - 1) / actorsPerPool Actor(mailbox, dispatcherId)) let writer = new MessageWriter<_>() for i = 0 to initCount - 1 do let destId = (i % actorCount) + 1 |> ActorId let payload = (i + 1) * 10000000 for i = 0 to batchSize - 1 do writer.WriteValue (payload + i * 10000 |> int64) if log then onSend { sourceId = ActorId.Undefined destId = destId sequence = 0 payload = payload |> int64 timestamp = Stopwatch.GetTimestamp() dispatcher = "" } writer.Outbox <- a writer.DestinationId <- destId writer.Send() a.ProcessAll() let expected = maxCount + initCount let actual = receivedCount.Value if actual <> expected then printfn $"Expected received count: %d{expected}, actual: %d{actual}" printfn "%s" <| a.ToString() let expected = maxCount let actual = sentCount.Value if actual <> expected then printfn $"Expected sent count: %d{expected}, actual: %d{actual}" if log then printfn $"%s{a.ToString()}" let run = runLogging false ignore ignore let runHistory log poolCount actorsPerPool workerCount duration initCount maxCount batchSize = let sent = SynchronizedQueue<_>() let received = SynchronizedQueue<_>() runLogging log sent.Enqueue received.Enqueue poolCount actorsPerPool workerCount duration initCount maxCount batchSize let sent = sent.Flush() |> Seq.toArray let received = received.Flush() |> Seq.toArray let sentSet = sent |> Seq.map (fun x -> (x.destId, x.payload), x) |> Map.ofSeq received |> Seq.map (fun x -> sentSet.[x.destId, x.payload], x) |> Seq.toArray let runMain log useMain (workerCount : int) initCount maxCount = let maxActorCount = maxCount * 2 - initCount let count = ref 0 let createInbox _ = let writer = new MessageWriter<_>() let mailbox = Mailbox() mailbox.OnAll <| fun e -> if Interlocked.Increment count <= maxActorCount then let span = e.Span for i = 0 to span.Length - 1 do writer.WriteValue span.[i] writer.Outbox <- mailbox writer.DestinationId <- mailbox.SourceId writer.Send() mailbox use a = new ActorSystem(workerCount) a.Register(ActorId 1, fun _ -> Actor(createInbox())) a.Register(ActorId 2, fun _ -> Actor(createInbox(), if useMain then 1 else 0)) for i = 1 to initCount do a.Send(ActorId 1, ActorId 2, int64 i) a.ProcessAll() if log then printfn $"%s{a.ToString()}\n%d{count.Value}" type Run = struct end type Ping = struct end type Pong = struct end //[] //type SimplePingPongBenchmark() = // let a = new ActorSystem(0) // let mutable count = 0 // [] // member val N = 1 with get, set // [] // member this.Setup() = // a.Register(ActorId 1, fun _ -> // let h = Mailbox() // h.On <| fun e -> // h.Send(ActorId 2, Ping()) // h.On <| fun e -> // count <- count + 1 // if count < this.N then // h.Respond(Ping()) // Actor(h)) // a.Register(ActorId 2, fun _ -> // let h = Mailbox() // h.On <| fun e -> // h.Respond(Pong()) // Actor(h) // ) // [] // member this.SingleThread() = // count <- 0 // a.Process(ActorId 1, Run()) // a.ProcessAll() // count ================================================ FILE: tests/Garnet.Tests/Benchmarks/ActorBenchmarks.fsx ================================================ #r "../../../src/Garnet/bin/Release/net6.0/Garnet.dll" #load "ActorBenchmarks.fs" open Garnet.Benchmarks.Actors.PingPong open Garnet.Benchmarks.Actors.PingPong.Tests #time runHistory true 1 2 2 0 10 20 1 |> Seq.map RecordedMessage.formatPair |> Seq.iter (printfn "%s") runHistory false 200 16 0 1000 200000 1 |> ignore //runMain true true 1 10 6000 //runMain true true 0 10 4000000 //runMain true false 2 10 4000000 // poolCount actorsPerPool workerCount duration initCount maxCount batchSize // 0ms tasks run 1 1000 1 0 5000 4000000 1 run 1 1000 2 0 5000 4000000 1 // 0.845 run 1 1000 4 0 5000 4000000 1 run 1 1000 8 0 5000 4000000 1 // 1ms tasks run 1 1000 1 1 50 100 1 run 1 1000 2 1 50 100 1 // 0.774 run 1 1000 4 1 50 100 1 // 0.388 run 1 1000 8 1 50 100 1 // 1ms multiple pools run 2 500 2 1 50 100 1 // 0.525 run 2 500 4 1 50 100 1 // 0ms tasks run 1 1000 8 0 5000 1000000 100 run 1 1000 1 0 5000 10000000 1 // 2.726 run 1 1000 2 0 5000 10000000 1 // 2.088 run 1 1000 3 0 5000 10000000 1 // run 1 1000 4 0 5000 10000000 1 // 1.461 run 1 10000 8 0 50000 10000000 1 run 1 1000 8 1 5000 400 1 // multiple pools run 2 500 2 0 5000 10000000 1 // 1.573 run 1 1000 4 0 5000 10000000 1 // 1.512 run 1 1000 8 0 50000 10000000 1 run 1 5 1 0 10 20 1 run 1 2000 4 0 500 2000 1 run 1 1000 1 0 5000 5000000 20 run 1 1000 4 0 5000 4000000 1 // batch size 1000 run 1 1000 8 0 500 1000000 1000 run 1 1000 12 0 500 1000000 1000 // More threads than cores with large number of messages: // This reproduces issue where not all messages would be // completed. Using throughput=1 can also help to repro. runLogging true ignore ignore 1 5000 32 0 500 10000000 1 runLogging true ignore ignore 1 5000 16 0 500 10000000 1 runLogging true ignore ignore 1 5000 8 0 500 10000000 1 runLogging true ignore ignore 1 5000 6 0 500 10000000 1 runLogging true ignore ignore 1 5000 4 0 500 10000000 1 runLogging true ignore ignore 1 5000 2 0 500 10000000 1 runLogging true ignore ignore 1 5000 1 0 500 10000000 1 ================================================ FILE: tests/Garnet.Tests/Benchmarks/ChannelBenchmarks.fs ================================================ module Garnet.Benchmarks.Channels open Garnet.Composition let run iterations sendFreq = let mutable sum = 0L let c = Channels() let channel = c.GetChannel() let _ = c.On <| fun e -> sum <- sum + int64 e if e < iterations then if e % sendFreq = 0 then channel.Send (e + 1) else channel.Publish (e + 1) c.Publish 1 c.Commit() let mutable count = 0 while c.Publish() do c.Commit() count <- count + 1 sum, count let runWithoutCachingChannel iterations sendFreq = let mutable sum = 0L let c = Channels() let _ = c.On <| fun e -> sum <- sum + int64 e if e < iterations then if e % sendFreq = 0 then c.Send (e + 1) else c.Publish (e + 1) c.Publish 1 c.Commit() let mutable count = 0 while c.Publish() do c.Commit() count <- count + 1 sum, count let runBatches iterations batchSize = let mutable sum = 0L let mutable count = 0 let c = Channels() let channel = c.GetChannel() let _ = c.OnAll <| fun list -> for e in list.Span do sum <- sum + int64 e if count < iterations then count <- count + 1 for e in list.Span do channel.Send e for i = 1 to batchSize do c.Send i c.Commit() while c.Publish() do c.Commit() sum, count ================================================ FILE: tests/Garnet.Tests/Benchmarks/ChannelBenchmarks.fsx ================================================ #r "../bin/Release/net6.0/Garnet.dll" #load "ChannelBenchmarks.fs" open Garnet.Benchmarks.Channels #time run 30_000_000 1 run 30_000_000 10 runWithoutCachingChannel 30_000_000 1 runBatches 10_000_000 1 runBatches 1_000_000 100 ================================================ FILE: tests/Garnet.Tests/Benchmarks/ContainerBenchmarks.fs ================================================ module Garnet.Benchmarks.Containers open System.Collections.Generic open System.Numerics open Garnet.Composition let create1 count = let c = Container() for i = 1 to count do c.Create().Add(1) c.Commit() c let create2 count = let c = Container() for i = 1 to count do c.Create().With(5.0).Add(1) c.Commit() c let create3 count = let c = Container() for i = 1 to count do c.Create().With(Vector2(2.0f, 3.0f)).With(0.1).Add(1) c.Commit() c let create4 count = let c = Container() for i = 1 to count do c.Create().With("a").With(Vector2(2.0f, 3.0f)).With(0.1).Add(1) c.Commit() c let runCreateDestroyEntities count iterations = let c = Container() let eids = List() for i = 1 to iterations do for i = 1 to count do let e = c.Create() eids.Add(e.Id) c.Commit() for eid in eids do c.Destroy eid c.Commit() eids.Clear() let runCreateDestroyMultipleComponents count iterations = let c = Container() let eids = List() for i = 1 to iterations do for i = 1 to count do let e = c.Create().With(1).With("a").With(1.2).With('b') eids.Add(e.Id) c.Commit() for eid in eids do c.Destroy eid c.Commit() eids.Clear() let runAddRemoveComponent count iterations = let c = Container() let eids = List() for i = 1 to count do let e = c.Create() eids.Add(e.Id) for i = 1 to iterations do for eid in eids do c.Get(eid).Add(1) c.Commit() for eid in eids do c.Get(eid).Remove() c.Commit() let runAddRemoveComponentDirect count iterations = let c = Container() let eids = List() for i = 1 to count do let e = c.Create() eids.Add(e.Id) let cmp = c.GetComponents() for i = 1 to iterations do for eid in eids do cmp.Add(eid, 1) c.Commit() for eid in eids do cmp.Remove(eid) c.Commit() let runAddRemoveMultipleComponents count iterations = let c = Container() let eids = List() for i = 1 to count do let e = c.Create() eids.Add(e.Id) for i = 1 to iterations do for eid in eids do c.Get(eid).With(1).With("a").With(1.2).Add('b') c.Commit() for eid in eids do c.Get(eid).Without().Without().Without().Remove() c.Commit() let runIterateComponents1 count iterations = let c = create1 count let mutable sum = 0L let iter = fun _ (x1 : int) -> sum <- sum + int64 x1 |> Join.iter1 |> Join.over c for i = 1 to iterations do iter() sum let runIterateComponents2 count iterations = let c = create2 count let mutable sum = 0L let iter = fun _ struct(x1 : int, x2 : double) -> sum <- sum + int64 x1 + int64 x2 |> Join.iter2 |> Join.over c for i = 1 to iterations do iter() sum let runIterateComponents3 count iterations = let c = create3 count let mutable sum = 0L let iter = fun _ struct(x1 : int, x2 : double, x3 : Vector2) -> sum <- sum + int64 x1 + int64 x2 + int64 x3.X + int64 x3.Y |> Join.iter3 |> Join.over c for i = 1 to iterations do iter() sum let runIterateComponents4 count iterations = let c = create4 count let mutable sum = 0L let iter = fun _ struct(x1 : int, x2 : double, x3 : Vector2, x4 : string) -> sum <- sum + int64 x1 + int64 x2 + int64 x3.X + int64 x3.Y + int64 x4.Length |> Join.iter4 |> Join.over c for i = 1 to iterations do iter() sum let runQuerySegments1 count iterations = let c = create1 count let mutable sum = 0L for i = 1 to iterations do for seg, s1 in c.QuerySegments() do for i in seg do let x = s1.[i] sum <- sum + int64 x sum let runQuerySegments2 count iterations = let c = create2 count let mutable sum = 0L for i = 1 to iterations do for seg, s1, s2 in c.QuerySegments() do for i in seg do sum <- sum + int64 s1.[i] + int64 s2.[i] sum let runQuerySegments3 count iterations = let c = create3 count let mutable sum = 0L for i = 1 to iterations do for seg, s1, s2, s3 in c.QuerySegments() do for i in seg do sum <- sum + int64 s1.[i] + int64 s2.[i] + int64 s3.[i].X + int64 s3.[i].Y sum let runQuerySegments4 count iterations = let c = create4 count let mutable sum = 0L for i = 1 to iterations do for seg, s1, s2, s3, s4 in c.QuerySegments() do for i in seg do sum <- sum + int64 s1.[i] + int64 s2.[i] + int64 s3.[i].X + int64 s3.[i].Y + int64 s4.[i].Length sum let runQueryComponents1 count iterations = let c = create1 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do sum <- sum + int64 r.Value sum let runQueryComponentsTuple2 count iterations = let c = create2 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do let struct(x1, x2) = r.Values sum <- sum + int64 x1 + int64 x2 sum let runQueryComponentsTuple3 count iterations = let c = create3 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do let struct(x1, x2, x3) = r.Values sum <- sum + int64 x1 + int64 x2 + int64 x3.X + int64 x3.Y sum let runQueryComponentsTuple4 count iterations = let c = create4 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do let struct(x1, x2, x3, x4) = r.Values sum <- sum + int64 x1 + int64 x2 + int64 x3.X + int64 x3.Y + int64 x4.Length sum let runQueryComponents2 count iterations = let c = create2 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do sum <- sum + int64 r.Value1 + int64 r.Value2 sum let runQueryComponents3 count iterations = let c = create3 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do sum <- sum + int64 r.Value1 + int64 r.Value2 + int64 r.Value3.X + int64 r.Value3.Y sum let runQueryComponents4 count iterations = let c = create4 count let mutable sum = 0L for i = 1 to iterations do for r in c.Query() do sum <- sum + int64 r.Value1 + int64 r.Value2 + int64 r.Value3.X + int64 r.Value3.Y + int64 r.Value4.Length sum ================================================ FILE: tests/Garnet.Tests/Benchmarks/ContainerBenchmarks.fsx ================================================ #r "../bin/Release/net6.0/Garnet.dll" #load "ContainerBenchmarks.fs" open Garnet.Benchmarks.Containers #time runCreateDestroyEntities 10000 1000 runCreateDestroyMultipleComponents 10000 100 runAddRemoveComponent 10000 1000 runAddRemoveComponentDirect 10000 1000 runAddRemoveMultipleComponents 10000 100 // These are different ways of iterating over entities // Original function-based approach: runIterateComponents1 100000 1000 // 00:00:00.628 runIterateComponents2 100000 1000 // 00:00:00.970 runIterateComponents3 100000 1000 // 00:00:01.215 runIterateComponents4 100000 1000 // 00:00:01.201 // New enumerable approach: runQueryComponents1 100000 1000 // 00:00:00.265 runQueryComponents2 100000 1000 // 00:00:00.368 runQueryComponents3 100000 1000 // 00:00:00.518 runQueryComponents4 100000 1000 // 00:00:00.728 // New approach reading values to tuple: runQueryComponentsTuple2 100000 1000 // 00:00:01.122 runQueryComponentsTuple3 100000 1000 runQueryComponentsTuple4 100000 1000 // New approach using batches: runQuerySegments1 100000 1000 // 00:00:00.176 runQuerySegments2 100000 1000 // 00:00:00.254 runQuerySegments3 100000 1000 // 00:00:00.328 runQuerySegments4 100000 1000 // 00:00:00.578 ================================================ FILE: tests/Garnet.Tests/ChannelTests.fs ================================================ module Garnet.Tests.Channels open System.Collections.Generic open Expecto open Garnet.Composition [] let tests = testList "channels" [ testCase "send before subscribe" <| fun () -> let r = List<_>() let c = Channels() c.Send 1 let sub = c.On r.Add c.Commit() c.Publish() |> shouldEqual true r |> Seq.toList |> shouldEqual [ 1 ] testCase "publish before subscribe" <| fun () -> let r = List<_>() let c = Channels() c.Publish 1 let sub = c.On r.Add c.Commit() c.Publish() |> shouldEqual false r |> Seq.toList |> shouldEqual [] testCase "publish" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On r.Add for i = 1 to 10 do c.Publish i r |> Seq.toList |> shouldEqual [ 1..10 ] testCase "reentrant publish" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On <| fun e -> r.Add e if e < 10 then c.Publish (e + 1) c.Publish 1 r |> Seq.toList |> shouldEqual [ 1..10 ] testCase "send" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On <| fun e -> r.Add e if e < 10 then c.Send (e + 1) c.Publish 1 c.Commit() while c.Publish() do c.Commit() r |> Seq.toList |> shouldEqual [ 1..10 ] testCase "publish then send" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On <| fun e -> r.Add e if e < 10 then if e % 2 = 0 then c.Publish (e + 1) else c.Send (e + 1) c.Send 1 c.Commit() while c.Publish() do c.Commit() r |> Seq.toList |> shouldEqual [ 1..10 ] testCase "mixed send and publish" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On <| fun e -> r.Add e if e < 10 then if e % 2 = 0 then c.Publish (e + 1) else c.Send (e + 1) c.Publish 1 c.Commit() while c.Publish() do c.Commit() r |> Seq.toList |> shouldEqual [ 1..10 ] testCase "set publisher" <| fun () -> let r = List<_>() let c = Channels() let sub = c.On r.Add c.Send 1 c.Commit() c.Publish() |> shouldEqual true r |> Seq.toList |> shouldEqual [ 1 ] c.SetPublisher (ValueSome Publisher.Null) c.Send 2 c.Commit() c.Publish() |> shouldEqual true r |> Seq.toList |> shouldEqual [ 1 ] let r = List<_>() let sub = c.On r.Add c.Send "a" c.Commit() c.Publish() |> shouldEqual true r |> Seq.toList |> shouldEqual [] c.SetPublisher (ValueSome Publisher.Default) c.Send "a" c.Commit() c.Publish() |> shouldEqual true r |> Seq.toList |> shouldEqual [ "a" ] testCase "log publisher" <| fun () -> let r = List<_>() let c = Container() let sub = c.On <| fun e -> if e = 2 then failwith "error" c.Send "a" c.Publish 'b' c.SetPublisher(Publisher.Print { PrintPublisherOptions.enabled with SendLog = r.Add }) c.Run 1 try c.Run 2 with ex -> r.Add(sprintf "%s" <| ex.ToString()) c.Run "c" r.Count |> shouldEqual 6 ] ================================================ FILE: tests/Garnet.Tests/CollectionTests.fs ================================================ module Garnet.Tests.Collections open System open System.Collections.Generic open Expecto open Garnet.Collections [] let tests = testList "collections" [ testCase "enqueue to ring buffer" <| fun () -> let r = RingBuffer(2) r.TryEnqueue 1 |> shouldEqual true r.TryEnqueue 2 |> shouldEqual true r.TryEnqueue 3 |> shouldEqual false // dequeue let x = ref 0 r.TryDequeue x |> shouldEqual true x.Value |> shouldEqual 1 r.TryDequeue x |> shouldEqual true x.Value |> shouldEqual 2 r.TryDequeue x |> shouldEqual false // enqueue r.TryEnqueue 3 |> shouldEqual true r.TryDequeue x |> shouldEqual true x.Value |> shouldEqual 3 testCase "enqueue to ring buffer node" <| fun () -> let n = RingBufferNode(2) n.Enqueue 1 |> shouldEqual n n.Enqueue 2 |> shouldEqual n let n2 = n.Enqueue 3 n2 |> shouldNotEqual n n2.Enqueue 4 |> shouldEqual n2 let x = ref 0 n.TryDequeue x |> shouldEqual n x.Value |> shouldEqual 1 n.TryDequeue x |> shouldEqual n x.Value |> shouldEqual 2 n2.TryDequeue x |> shouldEqual n2 x.Value |> shouldEqual 3 n2.TryDequeue x |> shouldEqual n2 x.Value |> shouldEqual 4 n2.TryDequeue x |> shouldEqual null testCase "enqueue to ring buffer queue" <| fun () -> let items = List() let q = RingBufferQueue(2) [ 1..40 ] |> List.iter q.Enqueue q.DequeueAll (Action<_>(items.Add)) Expect.sequenceEqual items [ 1..40 ] "" ] ================================================ FILE: tests/Garnet.Tests/ComponentTests.fs ================================================ module Garnet.Tests.Components open System open System.Collections.Generic open Expecto open Garnet.Composition [] let tests = let create() = Components<_,_,EidSegmentKeyMapper,_>.Create() testList "components" [ testCase "get component" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Commit() s.GetOrDefault(Eid 1, 10) |> shouldEqual 10 testCase "get component without commit" <| fun () -> let s = create() s.Add(Eid 1, 10) Expect.throws (fun () -> s.Get(Eid 1) |> ignore) "exception expected" testCase "get component or default" <| fun () -> let s = create() s.GetOrDefault(Eid 1, 10) |> shouldEqual 10 testCase "add component multiple times" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Commit() s.Get(Eid 1) |> shouldEqual 10 s.Add(Eid 1, 11) s.Commit() s.Get(Eid 1) |> shouldEqual 11 testCase "add component multiple times before commit" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Add(Eid 1, 11) s.Commit() s.Get(Eid 1) |> shouldEqual 11 testCase "add and remove component before commit" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Remove(Eid 1) s.Commit() s.Contains(Eid 1) |> shouldEqual false testCase "remove and add component before commit" <| fun () -> let s = create() s.Remove(Eid 1) s.Add(Eid 1, 10) s.Commit() s.Get(Eid 1) |> shouldEqual 10 testCase "remove component not present" <| fun () -> let s = create() s.Remove(Eid 1) s.Commit() testCase "adding is deferred" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Count |> shouldEqual 0 s.Contains(Eid 1) |> shouldEqual false s.GetOrDefault(Eid 1, 0) |> shouldEqual 0 s.Commit() s.Count |> shouldEqual 1 s.Contains(Eid 1) |> shouldEqual true s.GetOrDefault(Eid 1, 0) |> shouldEqual 10 testCase "removal is deferred" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Commit() s.Remove(Eid 1) s.Count |> shouldEqual 1 s.Contains(Eid 1) |> shouldEqual true s.GetOrDefault(Eid 1, 0) |> shouldEqual 10 s.Commit() s.Count |> shouldEqual 0 s.Contains(Eid 1) |> shouldEqual false testCase "setting is immediate" <| fun () -> let s = create() s.Add(Eid 1, 10) s.Commit() s.Set(Eid 1, 11) s.Get(Eid 1) |> shouldEqual 11 testCase "random adding and removing" <| fun () -> let remove (list : List<_>) index = let eid = list.[index] list.[index] <- list.[list.Count - 1] list.RemoveAt(list.Count - 1) eid let s = create() let rand = Random(1) let added = List() let removed = List() let meanCount = 1000 for i = 1 to 60 do for i = 1 to 1000 do // half probability of add/removing let index = rand.Next(meanCount * 2) if index < added.Count then // remove component let eid = remove added index removed.Add(eid) s.Remove(eid) else // add component let index = index - added.Count let eid = if index < removed.Count then remove removed index else Eid (added.Count + removed.Count) added.Add(eid) s.Add(eid, eid.Value) s.Commit() for eid in added do s.Contains(eid) |> shouldEqual true s.Get(eid) |> shouldEqual eid.Value for eid in removed do s.Contains(eid) |> shouldEqual false ] ================================================ FILE: tests/Garnet.Tests/CoroutineTests.fs ================================================ module Garnet.Tests.Coroutines open System.Collections.Generic open Expecto open Garnet.Composition [] let tests = testList "coroutines" [ testCase "nested" <| fun _ -> let s = CoroutineScheduler() let r = List<_>() let append = r.Add s.Schedule <| seq { append 1 yield Wait.All append 2 // these happen in parallel s.Schedule <| seq { append 21 yield Wait.All append 22 } s.Schedule <| seq { append 31 yield Wait.All append 32 yield Wait.All append 33 } append 3 // here we block until two children complete yield Wait.All append 4 } s.Run() Expect.sequenceEqual [|1; 2; 3; 21; 31; 22; 32; 33; 4|] r "" testCase "waiting on messages" <| fun _ -> let c = Container() let r = List<_>() let append = r.Add c.On <| fun e -> if e = "1" then append 21 c.Send "2" elif e = "2" then append 22 c.Send "3" else append 23 |> ignore c.Start <| seq { append 1 c.Send "1" yield Wait.All append 2 } c.Run() // r.ToArray() Expect.sequenceEqual [|1; 21; 22; 23; 2|] r "" testCase "using container" <| fun _ -> let c = Container() let r = List<_>() let append = r.Add c.On <| fun e -> c.Start <| seq { append 21 yield Wait.All append 22 } |> ignore c.Start <| seq { append 1 yield Wait.All append 2 c.Send "" yield Wait.All append 3 yield Wait.All append 4 } c.Run() // coroutine waits for nested message handling Expect.sequenceEqual [|1; 2; 21; 22; 3; 4|] r "" testCase "timed" <| fun _ -> let s = CoroutineScheduler() let r = List<_>() let append = r.Add s.Schedule <| seq { append 1 yield Wait 2L append 2 append 3 s.Schedule <| seq { append 21 yield Wait 1L append 22 yield Wait 5L append 23 } yield Wait 3L append 4 append 5 } s.Run() for i = 1 to 8 do append (i * 100) s.Step 1L s.Run() //r.ToArray() Expect.sequenceEqual [|1; 100; 200; 2; 3; 21; 300; 22; 400; 500; 4; 5; 600; 700; 800; 23|] r "" testCase "timed nested using container" <| fun _ -> let c = Container() let r = List<_>() let append = r.Add c.On <| fun e -> c.Start <| seq { append 21 yield Wait.All append 22 yield Wait.All append 23 } |> ignore c.Start <| seq { append 1 c.Send "" yield Wait 0L append 2 } c.Run() // coroutine does not wait for nested message handling Expect.sequenceEqual [|1; 2; 21; 22; 23 |] r "" testCase "mixed nested using container" <| fun _ -> let c = Container() let r = List<_>() let append = r.Add c.On <| fun e -> if e = "update" then c.Start <| seq { append 21 yield Wait.All append 22 yield Wait.All append 23 } elif e = "anim" then c.Start <| seq { append 31 yield Wait 1L append 32 yield Wait 2L append 33 } |> ignore c.Start <| seq { append 1 c.Send "update" yield Wait.All append 2 c.Send "anim" yield Wait 5L append 3 } for i = 1 to 8 do append (i * 100) c.Step 1L c.Run() //r.ToArray() Expect.sequenceEqual [|100; 1; 21; 22; 23; 2; 31; 200; 32; 300; 400; 33; 500; 600; 3; 700; 800|] r "" ] ================================================ FILE: tests/Garnet.Tests/EntityTests.fs ================================================ module Garnet.Tests.Entities open System open System.Collections.Generic open Garnet.Composition open Expecto type Velocity = { velocity : int } type Position = { position : int } [] let tests = let getComponents (c : Segments<_,_>) = seq { for i = 0 to c.Count - 1 do let seg = c.[i] let mutable m = seg.Mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then yield seg.Data.[i] m <- m >>> 1 i <- i + 1 } testList "entities" [ testCase "increment ID version" <| fun () -> Eid(1, 0, 0).Gen |> shouldEqual 1 Eid(100).IncrementGen() |> shouldEqual (Eid(1, 0, 100)) testCase "incrementing ID version wraps" <| fun () -> Eid(Eid.MaxGen, 0, 100).IncrementGen() |> shouldEqual (Eid(0, 0, 100)) testCase "create IDs from pool" <| fun () -> let p = EidPools() [ for i = 1 to 100 do yield p.Next(0).Index ] |> shouldEqual [ 64..163 ] testCase "create IDs from partition" <| fun () -> let p = EidPool(5) p.Next().Value |> shouldEqual 0x500040 p.SegmentCount |> shouldEqual 2 testCase "create and destroy before commit" <| fun () -> let c = Container() let e = c.Create() e.Destroy() c.Commit() c.GetComponents().Count |> shouldEqual 0 testCase "create and destroy before commit with pooled" <| fun () -> let c = Container() let e1 = c.Create() c.Commit() let e2 = c.Create() e2.Destroy() c.Commit() c.GetComponents().Count |> shouldEqual 1 testCase "recycle ID to pool" <| fun () -> let segmentSize = 64 let c = Container() let usedIds = HashSet() for j = 1 to 100 do for i = 1 to segmentSize do let eid = c.Create().Id eid.Gen |> shouldEqual (j - 1) usedIds.Add(eid) |> shouldEqual true c.Destroy eid c.Commit() testCase "create entity" <| fun () -> let c = Container() let e = c.Create() e.Add { velocity = 3 } e.Add { position = 5 } c.GetSegments().Count |> shouldEqual 0 c.Commit() c.GetSegments().Count |> shouldEqual 1 c.GetSegments().Count |> shouldEqual 1 testCase "remove entity" <| fun () -> let c = Container() let e = c.Create() e.Add { velocity = 3 } c.Commit() e.Destroy() c.GetSegments().Count |> shouldEqual 1 c.GetSegments().Count |> shouldEqual 1 c.Commit() c.GetSegments().Count |> shouldEqual 0 c.GetSegments().Count |> shouldEqual 0 testCase "add and remove simultaneously" <| fun () -> let c = Container() // Eid and component go into additions let e = c.Create() e.Add 123 // Eid goes into removal e.Destroy() c.Commit() // so components are present c.GetSegments().Count |> shouldEqual 0 testCase "add and remove sequentially" <| fun () -> let c = Container() // Eid and component go into additions let e = c.Create() e.Add 123 // additions applied c.Commit() c.GetSegments().Count |> shouldEqual 1 // Eid goes into removal e.Destroy() // removals applied c.Commit() // so components are not present c.GetSegments().Count |> shouldEqual 0 testCase "add and remove entities randomly" <| fun () -> let iterations = 10000 let maxBatchSize = 1000 let print = false let rand = Random(1) let eids = HashSet() let active = List() let c = Container() for i = 1 to iterations do if print then printfn "Iteration %d" i let batchSize = min i maxBatchSize match rand.Next() % 3 with | 0 -> // create batch let count = rand.Next(batchSize) for i = 1 to count do let e = c.Create(rand.Next 16) if print then printfn "Create %A" e.Id if e.Id.Index < 64 then failwithf "Invalid value: %A" e.Id if not (eids.Add e.Id) then failwithf "Duplicate: %A" e.Id active.Add e.Id | 1 -> // destroy batch let count = rand.Next(min batchSize active.Count) for i = 1 to count do let ri = rand.Next(active.Count) let eid = active.[ri] active.[ri] <- active.[active.Count - 1] active.RemoveAt(active.Count - 1) c.Destroy(eid) if print then printfn "Destroy %A" eid | _ -> // commit and validate c.Commit() let eidStore = c.GetComponents() if print then printfn "Commit %s" <| c.ToString() getComponents eidStore.Segments |> Seq.toArray |> printfn "Active: %A" eidStore.Count |> shouldEqual active.Count c.Commit() ] ================================================ FILE: tests/Garnet.Tests/Garnet.Tests.fsproj ================================================  Exe net6.0 false ================================================ FILE: tests/Garnet.Tests/Iteration.fs ================================================ namespace Garnet.Composition open Garnet.Composition.Comparisons module Join = module Array = let iter1 action param mask (s1 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param s1.[i] m <- m >>> 1 i <- i + 1 let iter2 action param mask struct(s1 : _[], s2 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i]) m <- m >>> 1 i <- i + 1 let iter3 action param mask struct(s1 : _[], s2 : _[], s3 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i], s3.[i]) m <- m >>> 1 i <- i + 1 let iter4 action param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i], s3.[i], s4.[i]) m <- m >>> 1 i <- i + 1 let iter5 action param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i]) m <- m >>> 1 i <- i + 1 let iter6 action param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[], sf : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i], sf.[i]) m <- m >>> 1 i <- i + 1 let iter7 action param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[], s6 : _[], s7 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then action param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i], s6.[i], s7.[i]) m <- m >>> 1 i <- i + 1 let update1 map param mask (s1 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param s1.[i] m <- m >>> 1 i <- i + 1 let update2 map param mask struct(s1 : _[], s2 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i]) m <- m >>> 1 i <- i + 1 let update3 map param mask struct(s1 : _[], s2 : _[], s3 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i], s3.[i]) m <- m >>> 1 i <- i + 1 let update4 map param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i]) m <- m >>> 1 i <- i + 1 let update5 map param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i]) m <- m >>> 1 i <- i + 1 let update6 map param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[], s6 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i], s6.[i]) m <- m >>> 1 i <- i + 1 let update7 map param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[], s6 : _[], s7 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then s1.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i], s6.[i], s7.[i]) m <- m >>> 1 i <- i + 1 let add1 map param mask struct(sr : _[], s1 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then sr.[i] <- map param s1.[i] m <- m >>> 1 i <- i + 1 let add2 map param mask struct(sr : _[], s1 : _[], s2 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then sr.[i] <- map param struct(s1.[i], s2.[i]) m <- m >>> 1 i <- i + 1 let add3 map param mask struct(sr : _[], s1 : _[], s2 : _[], s3 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then sr.[i] <- map param struct(s1.[i], s2.[i], s3.[i]) m <- m >>> 1 i <- i + 1 let add4 map param mask struct(sr : _[], s1 : _[], s2 : _[], s3 : _[], s4 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then sr.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i]) m <- m >>> 1 i <- i + 1 let add5 map param mask struct(sr : _[], s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then sr.[i] <- map param struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i]) m <- m >>> 1 i <- i + 1 let fold1 action initState param mask (s1 : _[]) = let mutable m = mask let mutable i = 0 let mutable state = initState while m <> 0UL do if m &&& 1UL <> 0UL then state <- action param state s1.[i] m <- m >>> 1 i <- i + 1 state let fold2 action initState param mask struct(s1 : _[], s2 : _[]) = let mutable m = mask let mutable i = 0 let mutable state = initState while m <> 0UL do if m &&& 1UL <> 0UL then state <- action param state struct(s1.[i], s2.[i]) m <- m >>> 1 i <- i + 1 state let fold3 action initState param mask struct(s1 : _[], s2 : _[], s3 : _[]) = let mutable m = mask let mutable i = 0 let mutable state = initState while m <> 0UL do if m &&& 1UL <> 0UL then state <- action param state struct(s1.[i], s2.[i], s3.[i]) m <- m >>> 1 i <- i + 1 state let fold4 action initState param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[]) = let mutable m = mask let mutable i = 0 let mutable state = initState while m <> 0UL do if m &&& 1UL <> 0UL then state <- action param state struct(s1.[i], s2.[i], s3.[i], s4.[i]) m <- m >>> 1 i <- i + 1 state let fold5 action initState param mask struct(s1 : _[], s2 : _[], s3 : _[], s4 : _[], s5 : _[]) = let mutable m = mask let mutable i = 0 let mutable state = initState while m <> 0UL do if m &&& 1UL <> 0UL then state <- action param state struct(s1.[i], s2.[i], s3.[i], s4.[i], s5.[i]) m <- m >>> 1 i <- i + 1 state module Joins = let count (a : Segments<_,_>) = a.Count let get (a : Segments<_,_>) i = a.[i] let find (a : Segments<_,_>) sid = match a.TryFind(sid) with | true, i -> i | false, _ -> -1 let iter1 action a param = let c1 = count a for i1 = 0 to c1 - 1 do let s1 = get a i1 action param s1.Mask s1.Data let iter2 action struct(a, b) param = let c1 = count a let c2 = count b let mutable i1 = 0 let mutable i2 = 0 while i1 < c1 && i2 < c2 do let s1 = get a i1 let s2 = get b i2 let n1 = s1.Id let n2 = s2.Id if n1 < n2 then i1 <- i1 + 1 elif n2 < n1 then i2 <- i2 + 1 else let mask = s1.Mask &&& s2.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data) i1 <- i1 + 1 i2 <- i2 + 1 let iter3 action struct(a, b, c) param = let c1 = count a let c2 = count b let c3 = count c let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 while i1 < c1 && i2 < c2 && i3 < c3 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id if n1 < n2 || n1 < n3 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 then i3 <- i3 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data, s3.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 let iter4 action struct(a, b, c, d) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id if n1 < n2 || n1 < n3 || n1 < n4 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 then i4 <- i4 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data, s3.Data, s4.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 let iter5 action struct(a, b, c, d, e) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let c5 = count e let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 let mutable i5 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 && i5 < c5 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let s5 = get e i5 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id let n5 = s5.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 then i4 <- i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 then i5 <- i5 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask &&& s5.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data, s3.Data, s4.Data, s5.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 i5 <- i5 + 1 let iter6 action struct(a, b, c, d, e, f) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let c5 = count e let c6 = count f let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 let mutable i5 = 0 let mutable i6 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 && i5 < c5 && i6 < c6 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let s5 = get e i5 let s6 = get f i6 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id let n5 = s5.Id let n6 = s6.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 || n1 < n6 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 || n2 < n6 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 || n3 < n6 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 || n4 < n6 then i4 <- i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 || n5 < n6 then i5 <- i5 + 1 elif n6 < n1 || n6 < n2 || n6 < n3 || n6 < n4 || n6 < n5 then i6 <- i6 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask &&& s5.Mask &&& s6.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data, s3.Data, s4.Data, s5.Data, s6.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 i5 <- i5 + 1 i6 <- i6 + 1 let iter7 action struct(a, b, c, d, e, f, g) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let c5 = count e let c6 = count f let c7 = count g let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 let mutable i5 = 0 let mutable i6 = 0 let mutable i7 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 && i5 < c5 && i6 < c6 && i7 < c7 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let s5 = get e i5 let s6 = get f i6 let s7 = get g i7 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id let n5 = s5.Id let n6 = s6.Id let n7 = s7.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 || n1 < n6 || n1 < n7 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 || n2 < n6 || n2 < n7 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 || n3 < n6 || n3 < n7 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 || n4 < n6 || n4 < n7 then i4 <- i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 || n5 < n6 || n5 < n7 then i5 <- i5 + 1 elif n6 < n1 || n6 < n2 || n6 < n3 || n6 < n4 || n6 < n5 || n6 < n7 then i6 <- i6 + 1 elif n7 < n1 || n7 < n2 || n7 < n3 || n7 < n4 || n7 < n5 || n7 < n6 then i7 <- i7 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask &&& s5.Mask &&& s6.Mask &&& s7.Mask if mask <> 0UL then action param mask struct(s1.Data, s2.Data, s3.Data, s4.Data, s5.Data, s6.Data, s7.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 i5 <- i5 + 1 i6 <- i6 + 1 i7 <- i7 + 1 let iterKey1 action a param = let ca = count a for ia = 0 to ca - 1 do let sa = a.[ia] action param sa.Mask sa.Id sa.Data let iterKey2 action struct(a, b) param = let ca = count a let cb = count b let mutable ia = 0 let mutable ib = 0 while ia < ca && ib < cb do let sa = a.[ia] let sb = b.[ib] let na = sa.Id let nb = sb.Id if na < nb then ia <- ia + 1 elif nb < na then ib <- ib + 1 else let mask = sa.Mask &&& sb.Mask if mask <> 0UL then action param mask na struct(sa.Data, sb.Data) ia <- ia + 1 ib <- ib + 1 let iterKey3 action struct(a, b, c) param = let ca = count a let cb = count b let cc = count c let mutable ia = 0 let mutable ib = 0 let mutable ic = 0 while ia < ca && ib < cb && ic < cc do let sa = a.[ia] let sb = b.[ib] let sc = c.[ic] let na = sa.Id let nb = sb.Id let nc = sc.Id if na < nb || na < nc then ia <- ia + 1 elif nb < na || nb < nc then ib <- ib + 1 elif nc < na || nc < nb then ic <- ic + 1 else let mask = sa.Mask &&& sb.Mask &&& sc.Mask if mask <> 0UL then action param mask na struct(sa.Data, sb.Data, sc.Data) ia <- ia + 1 ib <- ib + 1 ic <- ic + 1 let iterKey4 action struct(a, b, c, d) param = let ca = count a let cb = count b let cc = count c let cd = count d let mutable ia = 0 let mutable ib = 0 let mutable ic = 0 let mutable id = 0 while ia < ca && ib < cb && ic < cc && id < cd do let sa = a.[ia] let sb = b.[ib] let sc = c.[ic] let sd = d.[id] let na = sa.Id let nb = sb.Id let nc = sc.Id let nd = sd.Id if na < nb || na < nc || na < nd then ia <- ia + 1 elif nb < na || nb < nc || nb < nd then ib <- ib + 1 elif nc < na || nc < nb || nc < nd then ic <- ic + 1 elif nd < na || nd < nb || nd < nc then id <- id + 1 else let mask = sa.Mask &&& sb.Mask &&& sc.Mask &&& sd.Mask if mask <> 0UL then action param mask na struct(sa.Data, sb.Data, sc.Data, sd.Data) ia <- ia + 1 ib <- ib + 1 ic <- ic + 1 id <- id + 1 /// Creates components when present in A and missing from R let add1 action struct(r, a) param = let c1 = count a for i1 = 0 to c1 - 1 do let s1 = get a i1 let ir = find r s1.Id let mask = s1.Mask let sid = s1.Id if ir < 0 then let data = r.Add(sid, mask) action param mask struct(data, s1.Data) else let sr = r.[ir] let addMask = mask &&& ~~~sr.Mask if addMask <> 0UL then let data = r.Add(sid, addMask) action param addMask struct(data, s1.Data) /// Creates components when present in A and B and missing from R let add2 action struct(r, a, b) param = let c1 = count a let c2 = count b let mutable i1 = 0 let mutable i2 = 0 while i1 < c1 && i2 < c2 do let s1 = get a i1 let s2 = get b i2 let n1 = s1.Id let n2 = s2.Id if n1 < n2 then i1 <- i1 + 1 elif n2 < n1 then i2 <- i2 + 1 else let mask = s1.Mask &&& s2.Mask if mask <> 0UL then let sid = s1.Id let ir = find r sid if ir < 0 then let data = r.Add(sid, mask) action param mask struct(data, s1.Data, s2.Data) else let sr = r.[ir] let addMask = mask &&& ~~~sr.Mask if addMask <> 0UL then let data = r.Add(sid, addMask) action param addMask struct(data, s1.Data, s2.Data) i1 <- i1 + 1 i2 <- i2 + 1 /// Creates components when present in A and B and C and missing from R let add3 action struct(r, a, b, c) param = let c1 = count a let c2 = count b let c3 = count c let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 while i1 < c1 && i2 < c2 && i3 < c3 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id if n1 < n2 || n1 < n3 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 then i3 <- i3 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask if mask <> 0UL then let sid = s1.Id let ir = find r sid if ir < 0 then let data = r.Add(sid, mask) action param mask struct(data, s1.Data, s2.Data, s3.Data) else let sr = r.[ir] let addMask = mask &&& ~~~sr.Mask if addMask <> 0UL then let data = r.Add(sid, addMask) action param addMask struct(data, s1.Data, s2.Data, s3.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 /// Creates components when present in A and B and C and missing from R let add4 action struct(r, a, b, c, d) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id if n1 < n2 || n1 < n3 || n1 < n4 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 then i4 <- i4 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask if mask <> 0UL then let sid = s1.Id let ir = find r sid if ir < 0 then let data = r.Add(sid, mask) action param mask struct(data, s1.Data, s2.Data, s3.Data, s4.Data) else let sr = r.[ir] let addMask = mask &&& ~~~sr.Mask if addMask <> 0UL then let data = r.Add(sid, addMask) action param addMask struct(data, s1.Data, s2.Data, s3.Data, s4.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 let add5 action struct(r, a, b, c, d, e) param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let c5 = count e let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable i4 = 0 let mutable i5 = 0 while i1 < c1 && i2 < c2 && i3 < c3 && i4 < c4 && i5 < c5 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d i4 let s5 = get e i5 let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id let n5 = s5.Id if n1 < n2 || n1 < n3 || n1 < n4 || n1 < n5 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 || n2 < n5 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 || n3 < n5 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 || n4 < n5 then i4 <- i4 + 1 elif n5 < n1 || n5 < n2 || n5 < n3 || n5 < n4 then i5 <- i5 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask &&& s5.Mask if mask <> 0UL then let sid = s1.Id let ir = find r sid if ir < 0 then let data = r.Add(sid, mask) action param mask struct(data, s1.Data, s2.Data, s3.Data, s4.Data, s5.Data) else let sr = r.[ir] let addMask = mask &&& ~~~sr.Mask if addMask <> 0UL then let data = r.Add(sid, addMask) action param addMask struct(data, s1.Data, s2.Data, s3.Data, s4.Data, s5.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 i4 <- i4 + 1 i5 <- i5 + 1 let fold1 action a initState param = let mutable state = initState let c1 = count a for i1 = 0 to c1 - 1 do let s1 = a.[i1] state <- action state param s1.Mask s1.Data state let fold2 action struct(a, b) initState param = let c1 = count a let c2 = count b let mutable i1 = 0 let mutable i2 = 0 let mutable state = initState while i1 < c1 && i2 < c2 do let s1 = a.[i1] let s2 = b.[i2] let n1 = s1.Id let n2 = s2.Id if n1 < n2 then i1 <- i1 + 1 elif n2 < n1 then i2 <- i2 + 1 else let mask = s1.Mask &&& s2.Mask if mask <> 0UL then state <- action state param mask struct(s1.Data, s2.Data) i1 <- i1 + 1 i2 <- i2 + 1 state let fold3 action struct(a, b, c) initState param = let c1 = count a let c2 = count b let c3 = count c let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable state = initState while i1 < c1 && i2 < c2 && i3 < c3 do let s1 = a.[i1] let s2 = b.[i2] let s3 = c.[i3] let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id if n1 < n2 || n1 < n3 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 then i3 <- i3 + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask if mask <> 0UL then state <- action state param mask struct(s1.Data, s2.Data, s3.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 state let fold4 action struct(a, b, c, d) initState param = let c1 = count a let c2 = count b let c3 = count c let c4 = count d let mutable i1 = 0 let mutable i2 = 0 let mutable i3 = 0 let mutable id = 0 let mutable state = initState while i1 < c1 && i2 < c2 && i3 < c3 && id < c4 do let s1 = get a i1 let s2 = get b i2 let s3 = get c i3 let s4 = get d id let n1 = s1.Id let n2 = s2.Id let n3 = s3.Id let n4 = s4.Id if n1 < n2 || n1 < n3 || n1 < n4 then i1 <- i1 + 1 elif n2 < n1 || n2 < n3 || n2 < n4 then i2 <- i2 + 1 elif n3 < n1 || n3 < n2 || n3 < n4 then i3 <- i3 + 1 elif n4 < n1 || n4 < n2 || n4 < n3 then id <- id + 1 else let mask = s1.Mask &&& s2.Mask &&& s3.Mask &&& s4.Mask if mask <> 0UL then state <- action state param mask struct(s1.Data, s2.Data, s3.Data, s4.Data) i1 <- i1 + 1 i2 <- i2 + 1 i3 <- i3 + 1 id <- id + 1 state module Segments = let get (c : ISegmentStore<_>) = c.GetSegments() let get2 c = struct(get c, get c) let get3 c = struct(get c, get c, get c) let get4 c = struct(get c, get c, get c, get c) let get5 c = struct(get c, get c, get c, get c, get c) let get6 c = struct(get c, get c, get c, get c, get c, get c) let get7 c = struct(get c, get c, get c, get c, get c, get c, get c) let iter1 a c = get c |> Joins.iter1 a let iter2 a c = get2 c |> Joins.iter2 a let iter3 a c = get3 c |> Joins.iter3 a let iter4 a c = get4 c |> Joins.iter4 a let iter5 a c = get5 c |> Joins.iter5 a let iter6 a c = get6 c |> Joins.iter6 a let iter7 a c = get7 c |> Joins.iter7 a let iterKey1 a c = get c |> Joins.iterKey1 a let iterKey2 a c = get2 c |> Joins.iterKey2 a let iterKey3 a c = get3 c |> Joins.iterKey3 a let iterKey4 a c = get4 c |> Joins.iterKey4 a let add1 a c = get2 c |> Joins.add1 a let add2 a c = get3 c |> Joins.add2 a let add3 a c = get4 c |> Joins.add3 a let add4 a c = get5 c |> Joins.add4 a let add5 a c = get6 c |> Joins.add5 a let fold1 a c = get c |> Joins.fold1 a let fold2 a c = get2 c |> Joins.fold2 a let fold3 a c = get3 c |> Joins.fold3 a let fold4 a c = get4 c |> Joins.fold4 a let iter1 a = a |> Array.iter1 |> Segments.iter1 let iter2 a = a |> Array.iter2 |> Segments.iter2 let iter3 a = a |> Array.iter3 |> Segments.iter3 let iter4 a = a |> Array.iter4 |> Segments.iter4 let iter5 a = a |> Array.iter5 |> Segments.iter5 let iter6 a = a |> Array.iter6 |> Segments.iter6 let iter7 a = a |> Array.iter7 |> Segments.iter7 let add1 a = a |> Array.add1 |> Segments.add1 let add2 a = a |> Array.add2 |> Segments.add2 let add3 a = a |> Array.add3 |> Segments.add3 let add4 a = a |> Array.add4 |> Segments.add4 let add5 a = a |> Array.add5 |> Segments.add5 let update1 a = a |> Array.update1 |> Segments.iter1 let update2 a = a |> Array.update2 |> Segments.iter2 let update3 a = a |> Array.update3 |> Segments.iter3 let update4 a = a |> Array.update4 |> Segments.iter4 let update5 a = a |> Array.update5 |> Segments.iter5 let update6 a = a |> Array.update6 |> Segments.iter6 let update7 a = a |> Array.update7 |> Segments.iter7 let fold1 a = a |> Array.fold1 |> Segments.fold1 let fold2 a = a |> Array.fold2 |> Segments.fold2 let fold3 a = a |> Array.fold3 |> Segments.fold3 let fold4 a = a |> Array.fold4 |> Segments.fold4 let list procs = fun c -> procs |> List.iter (fun proc -> proc c) /// Takes a single event processor and returns a processor which operates on a batch of events let batch proc = fun c -> let run = proc c fun (events : List<_>) -> for e in events do run e let where pred action = fun param values -> if pred param values then action param values let over c proc = proc c let run param iter = iter param ================================================ FILE: tests/Garnet.Tests/IterationTests.fs ================================================ module Garnet.Tests.Iteration open System open System.Collections.Generic open Expecto open Garnet.Composition [] let tests = testList "iteration" [ testCase "iter2" <| fun () -> let c = ComponentStore<_,_,EidSegmentKeyMapper>() for i = 1 to 100 do let e = c.Get(Eid i) if i % 2 = 0 then e.Add(i) if i % 3 = 0 then e.Add('a' + char i) if i % 5 = 0 then e.Add(i.ToString()) c.Commit() let r = List<_>() let iter = fun param struct(a : int, b : string) -> r.Add((param, a, b)) |> Join.iter2 |> Join.over c iter 0 r.Count |> shouldEqual 10 let r = List<_>() let iter = fun param struct(a : int, b : char) -> r.Add((param, a, b)) |> Join.iter2 |> Join.over c iter 0 r.Count |> shouldEqual 16 testCase "where" <| fun () -> let c = ComponentStore<_,_,EidSegmentKeyMapper>() for i = 1 to 100 do let e = c.Get(Eid i) e.Add(i) e.Add(Eid i) c.Commit() let r = List<_>() let iterWhere = fun param struct(a : int, b : Eid) -> r.Add((param, a, b)) |> Join.where (fun param struct(a : int, _ : Eid) -> a % 2 = 0) |> Join.iter2 |> Join.over c iterWhere 0 r.Count |> shouldEqual 50 testCase "add4" <| fun () -> let c = Container() let mutable count = 0 let add4 = fun () struct(a : string, b : int, c : char, d : byte) -> count <- count + 1 1us |> Join.add4 |> Join.over c for i = 1 to 10 do c.Create().With("").With(1).With('a').Add(1uy) for i = 1 to 10 do c.Create().With("").With(1).Add('a') c.Commit() add4() count |> shouldEqual 10 c.Commit() add4() count |> shouldEqual 10 ] ================================================ FILE: tests/Garnet.Tests/Main.fs ================================================ module Garnet.Tests.Program open Expecto [] let main argv = Tests.runTestsInAssembly { defaultConfig with verbosity = Logging.LogLevel.Verbose } argv ================================================ FILE: tests/Garnet.Tests/QueryTests.fs ================================================ module Garnet.Tests.Query open System open System.Collections.Generic open Expecto open Garnet.Composition [] let tests = let testMaskIteration mask = let mutable r = 0UL let mutable last = -1 for i in MaskEnumerable(mask) do if i <= last || i < 0 || i >= 64 then failwith $"Invalid index {i}" r <- r ||| (1UL <<< i) last <- i r |> shouldEqual mask testList "query" [ testCase "iterate over mask" <| fun () -> testMaskIteration 0UL testMaskIteration UInt64.MaxValue testMaskIteration 0x10UL let rand = Random(1) for i = 1 to 1000 do let x = (uint64 (rand.Next()) <<< 32) ||| (uint64 (rand.Next())) testMaskIteration x testCase "iter2" <| fun () -> let c = ComponentStore<_,_,EidSegmentKeyMapper>() for i = 1 to 100 do let e = c.Get(Eid i) if i % 2 = 0 then e.Add(i) if i % 3 = 0 then e.Add('a' + char i) if i % 5 = 0 then e.Add(i.ToString()) c.Commit() let r = List<_>() for row in c.Query() do r.Add(row.Values) r.Count |> shouldEqual 10 let r = List<_>() for row in c.Query() do r.Add(row.Values) r.Count |> shouldEqual 16 testCase "update2" <| fun () -> let c = Container() let e = c.Create().With(1L).With(5) c.Commit() for r in c.Query() do let p = &r.Value1 let v = r.Value2 p <- p + int64 v e.Get() |> shouldEqual 6L ] ================================================ FILE: tests/Garnet.Tests/ReadmeSamples.fs ================================================ module Garnet.Tests.Examples open Garnet.Composition // Common type Msg = struct end type UpdatePositions = struct end type DestroyZeroHealth = struct end type EnemyMarker = struct end [] type Position = { x : float32; y : float32 } [] type Velocity = { vx : float32; vy : float32 } // create a world let world = Container() module Example1a = // events [] type Update = { dt : float32 } // register a system that updates position let system = world.On ( fun e struct(p : Position, v : Velocity) -> { x = p.x + v.vx * e.dt y = p.y + v.vy * e.dt } |> Join.update2 |> Join.over world) module Example1b = // events [] type Update = { dt : float32 } // register a system that updates position let system = world.On <| fun e -> for r in world.Query() do let p = &r.Value1 let v = r.Value2 p <- { x = p.x + v.vx * e.dt y = p.y + v.vy * e.dt } [] type Health = { hp : int } module HashSpaceSystem = let register (c : Container) = Disposable.Create [ ] let c = Container() // Subscribing to events [] type UpdateTime = { dt : float32 } // sub is IDisposable, which can be used to unsubscribe let sub = c.On <| fun e -> // [do update here] printfn "%A" e // Defining systems // a system is just a group of related subscriptions, // optionally with a name module MovementSystem = // separate methods as needed let registerUpdate (c : Container) = c.On <| fun e -> printfn "%A" e // combine all together let register (c : Container) = Disposable.Create [ registerUpdate c ] [] module MovementSystemExtensions = type Container with member c.AddMovementUpdate() = c.On <| fun e -> printfn "%A" e member c.AddMovementSystems() = Disposable.Create [ c.AddMovementUpdate() ] // Iterating over entities let runIter = // first define an iteration callback: // (1) param can be any type or just ignored // (2) use struct record for component types fun param struct(eid : Eid, p : Position, h : Health) -> if h.hp <= 0 then // [start animation at position] // destroy entity c.Destroy(eid) // iterate over all entities with all components // present (inner join) |> Join.iter3 // iterate over container |> Join.over c let healthSub = c.On <| fun e -> runIter() let healthSubQuery = c.On <| fun e -> for r in c.Query() do let h = r.Value3 if h.hp <= 0 then let eid = r.Value1 c.Destroy(eid) let healthSubBatchQuery = c.On <| fun e -> for seg, eids, _, hs in c.QuerySegments() do for i in seg do let h = hs.[i] if h.hp <= 0 then let eid = eids.[i] c.Destroy(eid) // Composing systems module CoreSystems = let register (c : Container) = Disposable.Create [ MovementSystem.register c HashSpaceSystem.register c ] // Running stack-like coroutines let system = c.On <| fun e -> printf "2 " // start a coroutine c.Start <| seq { printf "1 " // send message and defer execution until all messages and // coroutines created as a result of this have completed c.Send <| Msg() yield Wait.All printf "3 " } // run until completion // output: 1 2 3 c.Run() // Updating in stages // events type Update = struct end type UpdatePhysicsBodies = struct end type UpdateHashSpace = struct end // systems let updateSystem = c.On <| fun e -> c.Start <| seq { // using shorthand 'send and defer' to suspend // execution here to achieve ordering of // sub-updates yield c.Wait <| UpdatePhysicsBodies() yield c.Wait <| UpdateHashSpace() } let system1 = c.On <| fun e -> // [update positions] printfn "%A" e let system2 = c.On <| fun e -> // [update hash space from positions] printfn "%A" e // Running time-based coroutines // start a coroutine c.Start <| seq { for i = 1 to 5 do printf "[%d] " i // yield execution until time units pass yield Wait 3L } // simulate update loop // output: [1] 1 2 3 [2] 4 5 6 [3] 7 8 9 for i = 1 to 9 do // increment time units and run pending coroutines c.Step 1L c.Run() printf "%d " i // Creating actors // message types type Ping = struct end type Pong = struct end // actor definitions let a = new ActorSystem() a.Register(ActorId 1, fun (c : Container) -> c.On <| fun e -> printf "ping " c.Respond(Pong()) ) a.Register(ActorId 2, fun (c : Container) -> c.On <| fun e -> printf "pong " ) // send a message and run until all complete // output: ping pong a.Send(ActorId 1, ActorId 2, Ping()) a.ProcessAll() // Subscribing to event batch [] type AddShip = { x : float32; y : float32 } let batchSub = c.OnAll <| fun list -> for e in list.Span do // [do update here] printfn "%A" e // Creating an entity let entity = c.Create() .With({ x = 10.0f; y = 5.0f }) .With({ vx = 1.0f; vy = 2.0f }) // Defining a container actor let test() = use a = new ActorSystem() a.Register(ActorId 1, fun (c : Container) -> c.On <| fun e -> c.Respond(Pong())) a.Register(ActorId 2, fun (c : Container) -> c.On <| fun e -> c.Respond(Pong())) a.Send(ActorId 1, Ping()) a.ProcessAll() ================================================ FILE: tests/Garnet.Tests/Recording.fs ================================================ namespace Garnet.Streaming open System open System.IO open System.Collections.Generic open System.Text open Garnet.Composition.Comparisons open Garnet.Composition type ActorLogFilter = { actorFilter : ActorId -> bool sourceFilter : ActorId -> bool destinationFilter : ActorId -> bool } module ActorLogFilter = let isAny (_ : ActorId) = true let all = { actorFilter = isAny sourceFilter = isAny destinationFilter = isAny } let singleLog actorId = { actorFilter = (=)actorId sourceFilter = isAny destinationFilter = isAny } let toActor actorId = { actorFilter = (=)actorId sourceFilter = isAny destinationFilter = isAny } let receivedBy actorId = { actorFilter = (=)actorId sourceFilter = isAny destinationFilter = (=)actorId } let sent actorId = { actorFilter = (=)actorId sourceFilter = isAny destinationFilter = (<>)actorId } let sentTo actorId destinationId = { actorFilter = (=)actorId sourceFilter = isAny destinationFilter = (=)destinationId } [] type MessageRange = { messageTypeId : int start : int count : int } module MessageRange = let init id start count = { messageTypeId = id start = start count = count } let typeCount id count = init id 0 count let count count = typeCount 0 count let all = count Int32.MaxValue type PrintOptions = { createMessageRegistry : unit -> MessageRegistry createFormatter : unit -> Formatter print : string -> unit filter : ActorLogFilter range : MessageRange } module PrintOptions = let range r opt = { opt with range = r } let filtered filter opt = { opt with filter = filter } let count c opt = range (MessageRange.count c) opt type ReplayOptions = { createMessageRegistry : unit -> MessageRegistry filter : ActorLogFilter range : MessageRange } type IActorStreamReader = abstract member GetActorIds : unit -> ActorId seq abstract member OpenRead : ActorId -> Stream type IActorStreamWriter = abstract member OpenWrite : ActorId -> Stream type IActorStreamSource = inherit IActorStreamReader inherit IActorStreamWriter /// Multiple files in a directory /// Stream lookup is thread-safe, but reading/writing is not type DirectoryActorStreamSource(path) = let prefix = "actor-" let extension = ".log" let sync = obj() let getFullPath (actorId : ActorId) = let file = sprintf "%s%d%s" prefix actorId.Value extension Path.Combine(path, file) interface IActorStreamSource with member c.GetActorIds() = lock sync <| fun () -> Directory.EnumerateFiles(path, prefix + "*" + extension) |> Seq.map (fun file -> // remove prefix and extension, then extract number let name = Path.GetFileNameWithoutExtension(file) Int32.Parse(name.Replace(prefix, "")) |> ActorId) |> Seq.cache member c.OpenRead (id : ActorId) = lock sync <| fun () -> let fullPath = getFullPath id File.OpenRead(fullPath) :> Stream member c.OpenWrite (id : ActorId) = lock sync <| fun () -> let fullPath = getFullPath id Directory.CreateDirectory path |> ignore File.OpenWrite(fullPath) :> Stream /// Single file/stream type FileActorStreamSource(path) = let actorIds = [| ActorId.Undefined |] :> seq<_> interface IActorStreamSource with member c.GetActorIds() = actorIds member c.OpenRead (id : ActorId) = File.OpenRead(path) :> Stream member c.OpenWrite (id : ActorId) = File.OpenWrite(path) :> Stream /// Note Dispose() is absent type private NonDisposingStream(stream : Stream) = inherit Stream() override c.Position with get() = stream.Position and set value = stream.Position <- value override c.CanRead = stream.CanRead override c.CanWrite = stream.CanWrite override c.CanSeek = stream.CanSeek override c.Length = stream.Length override c.Write(input, offset, count) = stream.Write(input, offset, count) override c.Read(output, offset, count) = stream.Read(output, offset, count) override c.Flush() = stream.Flush() override c.Seek(offset, origin) = stream.Seek(offset, origin) override c.SetLength(length) = stream.SetLength(length) /// Stream lookup is thread-safe, but reading/writing is not type MemoryActorStreamSource() = let logs = Dictionary<_,_>() let sync = obj() member private c.Open (id : ActorId) = lock sync <| fun () -> match logs.TryGetValue id with | true, x -> x | false, _ -> let ms = new MemoryStream() logs.Add(id, ms) ms member c.OpenWrite (id : ActorId) = new NonDisposingStream(c.Open id) :> Stream member c.GetActorIds() = lock sync <| fun () -> logs.Keys |> Seq.cache member c.OpenRead (id : ActorId) = let ms = c.Open id let length = int ms.Length let buffer = ms.GetBuffer() new MemoryStream(buffer, 0, length, false) :> Stream interface IActorStreamSource with member c.OpenWrite id = c.OpenWrite id member c.GetActorIds() = c.GetActorIds() member c.OpenRead id = c.OpenRead id override c.ToString() = String.Join("\n", logs |> Seq.map (fun kvp -> sprintf "%d: %d" kvp.Key.Value kvp.Value.Length)) [] type ActorLogCommand = { enableActorLog : bool } ================================================ FILE: tests/Garnet.Tests/RegistryTests.fs ================================================ module Garnet.Tests.Registry open Expecto open Garnet.Composition [] type TestClass() = class end [] let tests = testList "registry" [ testCase "resolve default" <| fun () -> let r = Registry() r.Get() |> isNull |> shouldEqual false testCase "resolve instance" <| fun () -> let r = Registry() r.Set("a") r.Get() |> shouldEqual "a" testCase "resolve ref" <| fun () -> let r = Registry() r.SetFactory(fun () -> ref 10) r.Get().Value |> shouldEqual 10 testCase "resolve circular" <| fun () -> let r = Registry() r.SetFactory(fun () -> ref (r.Get().Length)) r.SetFactory(fun () -> r.Get().ToString()) Expect.throws(fun () -> r.Get() |> ignore) "" testCase "instance overrides factory" <| fun () -> let r = Registry() r.Set("a") r.SetFactory(fun () -> "b") r.Get() |> shouldEqual "a" testCase "copy registry" <| fun () -> let r = Registry() r.Set(ref 10) r.Set("a") let r2 = Registry() r.CopyTo(r2) r2.Get().Value |> shouldEqual 10 r2.Get() |> shouldEqual "a" ] ================================================ FILE: tests/Garnet.Tests/RingBuffer.fs ================================================ namespace Garnet.Collections open System open System.Threading open Garnet.Composition.Comparisons module RingBuffer = let defaultBufferSize = 32 /// Single producer, single consumer type RingBuffer<'a>(size) = let buffer = Array.zeroCreate<'a> (size) [] let mutable readPos = 0 [] let mutable writePos = 0 new() = new RingBuffer<'a>(RingBuffer.defaultBufferSize) /// Assumes single thread access member c.TryEnqueue(item) = if writePos - readPos = buffer.Length then false else let index = writePos &&& (buffer.Length - 1) buffer.[index] <- item writePos <- writePos + 1 true /// Assumes single thread access member c.TryDequeue(item : byref<'a>) = if readPos = writePos then false else let index = readPos &&& (buffer.Length - 1) item <- buffer.[index] readPos <- readPos + 1 true /// Single producer, single consumer [] type RingBufferNode<'a>(size) = let buffer = RingBuffer(size) [] let mutable next = null new() = new RingBufferNode<'a>(RingBuffer.defaultBufferSize) member c.Enqueue(item) = // first try to add to current if buffer.TryEnqueue(item) then c else // if full, create a new node // next will only ever be set to non-null // need to guarantee this value will be written AFTER ring buffer // increment, otherwise consumer could miss an item next <- RingBufferNode(size * 2) next.Enqueue(item) /// Returns the node item was obtained from, or null if no item available member c.TryDequeue(item : byref<'a>) = // first look in current if buffer.TryDequeue(&item) then c // if empty, then either no items or writer moved onto another buffer // if another buffer, we can safely discard current buffer elif isNotNull next then next.TryDequeue(&item) else null member c.NodeCount = if isNull next then 1 else 1 + next.NodeCount /// Single producer, single consumer type RingBufferQueue<'a>(initialSize) = let mutable count = 0 let mutable enqueueCount = 0 let mutable dequeueCount = 0 let mutable allocatedCount = 1 [] let mutable readNode = RingBufferNode<'a>(initialSize) [] let mutable writeNode = readNode new() = new RingBufferQueue<'a>(RingBuffer.defaultBufferSize) member c.Count = count member c.Enqueue(item) = writeNode <- writeNode.Enqueue(item) Interlocked.Increment(&count) |> ignore enqueueCount <- enqueueCount + 1 member c.TryDequeue(item : byref<'a>) = let newReadNode = readNode.TryDequeue(&item) let isDequeued = isNotNull newReadNode if isDequeued then if not (obj.ReferenceEquals(readNode, newReadNode)) then readNode <- newReadNode allocatedCount <- allocatedCount + 1 Interlocked.Decrement(&count) |> ignore dequeueCount <- dequeueCount + 1 isDequeued member c.DequeueAll(action : Action<_>) = let mutable item = Unchecked.defaultof<'a> while c.TryDequeue(&item) do action.Invoke item override c.ToString() = sprintf "%d items, %d/%d nodes, %d enqueued, %d dequeued" count readNode.NodeCount allocatedCount enqueueCount dequeueCount type RingBufferPool<'a>(create) = let pool = RingBufferQueue<'a>() let onDispose = Action<_>(pool.Enqueue) member c.Get() = let mutable item = Unchecked.defaultof<'a> if pool.TryDequeue(&item) then item else create onDispose override c.ToString() = pool.ToString() ================================================ FILE: tests/Garnet.Tests/Scratch.fsx ================================================ #r "netstandard" #r "bin/Release/netcoreapp2.1/Garnet.dll" ================================================ FILE: tests/Garnet.Tests/SegmentTests.fs ================================================ module Garnet.Tests.Segments open System open Expecto open Garnet.Composition [] let tests = let copyArrayMask mask (src : _[]) (dest : _[]) = let mutable m = mask let mutable i = 0 while m <> 0UL do if m &&& 1UL <> 0UL then dest.[i] <- src.[i] m <- m >>> 1 i <- i + 1 testList "segments" [ testCase "add" <| fun () -> let s = Segments() s.Add(1, 0b111000UL).[5] <- 10 s.Count |> shouldEqual 0 s.Commit() s.Count |> shouldEqual 1 s.[0].Id |> shouldEqual 1 s.[0].Mask |> shouldEqual 0b111000UL s.[0].Data.[5] |> shouldEqual 10 testCase "remove" <| fun () -> let s = Segments() s.Add(1, 0b111000UL).[4] <- 10 s.Commit() s.Remove(1, 0b101000UL) s.[0].Mask |> shouldEqual 0b111000UL s.Commit() s.Count |> shouldEqual 1 s.[0].Mask |> shouldEqual 0b010000UL s.[0].Data.[4] |> shouldEqual 10 testCase "clear immediately" <| fun () -> let s = Segments() s.Add(1, UInt64.MaxValue) |> ignore s.Commit() s.Count |> shouldEqual 1 s.Clear() s.Count |> shouldEqual 0 testCase "data cleared before added back to pool" <| fun () -> let s = Segments() let data = s.Add(1, UInt64.MaxValue) Array.fill data 0 data.Length 1 s.Commit() let data = s.Add(2, 0UL) data.[0] |> shouldEqual 0 testCase "copy masked data" <| fun () -> let a = Array.init 64 id let b = Array.zeroCreate 64 copyArrayMask 0x00ff00ff00ffUL a b b.[1] |> shouldEqual 1 b.[8] |> shouldEqual 0 b.[16] |> shouldEqual 16 testCase "copy segments" <| fun () -> let s = SegmentStore() s.GetSegments().Add(1, UInt64.MaxValue) |> ignore s.Commit() s.GetSegments().Add(2, UInt64.MaxValue) |> ignore let s2 = SegmentStore() s.CopyTo(s2) s2.GetSegments().Count |> shouldEqual 0 s2.Commit() // note pending not copied s2.GetSegments().Count |> shouldEqual 1 ] ================================================ FILE: tests/Garnet.Tests/Serialization.fs ================================================ namespace Garnet.Streaming open System open System.IO open System.Collections.Generic open System.Runtime.InteropServices open Garnet.Composition type ISerializer<'a> = abstract member Write : Stream -> 'a -> unit abstract member Read : Stream -> 'a type Serializer<'a>(read, write) = interface ISerializer<'a> with member c.Write output value = write value output member c.Read input = read input [] module internal Serialization = let getNextPow2 x = let mutable y = x - 1 y <- y ||| (y >>> 1) y <- y ||| (y >>> 2) y <- y ||| (y >>> 4) y <- y ||| (y >>> 8) y <- y ||| (y >>> 16) y <- y + 1 if y > 0 then y else 1 let checkBlittable<'a>() = try let x = Array.zeroCreate<'a> 1 let handle = GCHandle.Alloc(x, GCHandleType.Pinned) handle.Free() true with _ -> false let copyFromBytes<'a> (src : byte[]) (dest : 'a[]) = let handle = GCHandle.Alloc(dest, GCHandleType.Pinned) let ptr = handle.AddrOfPinnedObject() Marshal.Copy(src, 0, ptr, src.Length) handle.Free() let copyToBytes<'a> (src : 'a[]) (dest : byte[]) = let handle = GCHandle.Alloc(src, GCHandleType.Pinned) let ptr = handle.AddrOfPinnedObject() Marshal.Copy(ptr, dest, 0, dest.Length) handle.Free() let serializer read write = Serializer(read, write) let isEmptyType (t : Type) = not (t.IsPrimitive || t.IsEnum || t.GetProperties().Length > 0) module internal LittleEndian = let writeInt32 (bytes : byte[]) offset x = bytes.[offset] <- x &&& 0xff |> byte bytes.[offset + 1] <- (x >>> 8) &&& 0xff |> byte bytes.[offset + 2] <- (x >>> 16) &&& 0xff |> byte bytes.[offset + 3] <- (x >>> 24) &&& 0xff |> byte type StringSerializer() = let mutable buffer = Array.zeroCreate 4 let resize length = if buffer.Length < length then Array.Resize(&buffer, getNextPow2 length) interface ISerializer with member c.Read stream = stream.Read(buffer, 0, 4) |> ignore let length = BitConverter.ToInt32(buffer, 0) resize length stream.Read(buffer, 0, length) |> ignore System.Text.Encoding.UTF8.GetString(buffer, 0, length) member c.Write stream value = LittleEndian.writeInt32 buffer 0 value.Length stream.Write(buffer, 0, 4) let length = System.Text.Encoding.UTF8.GetByteCount(value) resize length System.Text.Encoding.UTF8.GetBytes(value, 0, value.Length, buffer, 0) |> ignore stream.Write(buffer, 0, length) type RawSerializer<'a>() = let bytes = Array.zeroCreate sizeof<'a> let data = Array.zeroCreate<'a> 1 // for types without members, avoid writing any bytes let storedLength = if isEmptyType typeof<'a> then 0 else bytes.Length do if not (checkBlittable<'a>()) then failwithf "Type %s is not blittable" (typeof<'a>.Name) interface ISerializer<'a> with member c.Write (output : Stream) (value : 'a) = data.[0] <- value copyToBytes data bytes output.Write(bytes, 0, storedLength) member c.Read(input : Stream) = let count = input.Read(bytes, 0, storedLength) if count < bytes.Length then Unchecked.defaultof<'a> else copyFromBytes bytes data data.[0] type Accessor<'a, 'b> = { wrap : 'a -> 'b unwrap : 'b -> 'a } type WrappedStringSerializer<'a>(accessor) = let serializer = StringSerializer() :> ISerializer interface ISerializer<'a> with member c.Write (output : Stream) (value : 'a) = serializer.Write output (accessor.unwrap value) member c.Read(input : Stream) = serializer.Read input |> accessor.wrap type IFactory = abstract member Create<'a> : unit -> obj type MessageTypeInfo = { messageType : Type typeId : int serializer : obj create : Func } [] type MessageTypeInfo<'a> = { typeId : int serializer : ISerializer<'a> } type MessageRegistry() = let typeLookup = Dictionary() let idLookup = Dictionary() member c.Get<'a>() = let t = typeof<'a> match typeLookup.TryGetValue(t) with | false, _ -> failwithf "Message type %s not registered" t.Name | true, info -> { typeId = info.typeId serializer = info.serializer :?> ISerializer<'a> } member c.Get id = match idLookup.TryGetValue(id) with | false, _ -> failwithf "Message ID %d not registered" id | true, info -> info member c.Ignore<'a>() = let read s = Unchecked.defaultof<'a> let write value s = () c.Register<'a> 0 (serializer read write) member c.Register<'a> id (serializer : ISerializer<'a>) = let t = typeof<'a> let info = { messageType = t typeId = id serializer = serializer create = Func<_,_>(fun factory -> factory.Create<'a>()) } typeLookup.Add(t, info) if id <> 0 then idLookup.Add(id, info) [] type MessageHeader = { sourceId : ActorId destinationId : ActorId messageTypeId : int messageCount : int } module MessageHeader = let empty = { sourceId = ActorId 0 destinationId = ActorId 0 messageTypeId = 0 messageCount = 0 } type IMessageStreamReader = abstract member Start : MessageHeader -> IOutbox -> unit abstract member Read : Stream -> unit abstract member Flush : unit -> unit ================================================ FILE: tests/Garnet.Tests/SerializationTests.fs ================================================ module Garnet.Tests.Serialization open System.IO open Expecto open Garnet.Streaming let testRoundtripValue (serializer : ISerializer<_>) x = let ms = new MemoryStream() serializer.Write ms x ms.Position <- 0L let x2 = serializer.Read ms x2 |> shouldEqual x //printfn "%s: %d" (typeToString (serializer.GetType())) ms.Length let testRoundtrip (serializer : ISerializer<_>) = let x = Unchecked.defaultof<_> testRoundtripValue serializer x [] type Test1 = { field1 : int field2 : uint64 field3 : uint64 } type Enum1 = | Case1 = 0uy [] type Test2 = { field1 : int field2 : Enum1 field3 : Test1 } [] let tests = testList "serialization" [ testCase "raw serialization roundtrips" <| fun () -> testRoundtrip (RawSerializer()) testRoundtrip (RawSerializer()) testRoundtrip (RawSerializer()) testRoundtrip (RawSerializer()) ] ================================================ FILE: tests/Garnet.Tests/StateMachineTests.fs ================================================ module Garnet.Tests.StateMachine open Garnet.Composition open Expecto module Partition = let globals = 0 let objects = 1 [] type WorldStatus = | WorldInactive | WorldActive type CreateWorld = struct end type Update = struct end module WorldSystems = let inactive (c : Container) = c.On <| fun e -> // populate world c.Create(Partition.objects).Add(1) // switch to active state c.Send WorldActive let active (c : Container) = let update = fun param (x : int) -> x + 1 |> Join.update1 |> Join.over c Disposable.Create [ c.On <| fun e -> update() ] /// Maps a state value to a registration for the state let getState (status : WorldStatus) = match status with | WorldInactive -> inactive | WorldActive -> active let registerCommon (c : Container) = // register systems common across all states here Disposable.Null let register (c : Container) = Disposable.Create [ registerCommon c // register so that state is stored in a globals entity // and we start in inactive state c.AddStateMachine(WorldInactive, getState) ] [] let tests = testList "state machine" [ testCase "create state machine container" <| fun () -> let c = Container() let sub = WorldSystems.register c c.Run(Update()) c.GetComponents().Count |> shouldEqual 0 c.Run(CreateWorld()) c.GetComponents().Count |> shouldEqual 1 ] ================================================ FILE: tests/Garnet.Tests/StrategySample.fs ================================================ module Garnet.Tests.StrategySample // This sample demonstrates using component storage for grid cells // for use in a strategy game. open System open System.Text open Garnet.Composition // primitives [] type Loc = { x : int; y : int } with override c.ToString() = sprintf "(%d, %d)" c.x c.y [] type Size = { w : int; h : int } // Components are stored in size 64 segments, so we need to define a mapping // from component keys to segment key and index within segment. [] type LocSegmentKeyMapper = interface ISegmentKeyMapper with member c.GetSegmentKey(p) = { x = p.x >>> 3; y = p.y >>> 3 } member c.GetComponentIndex(p) = ((p.y &&& 7) <<< 3) ||| (p.x &&& 7) // events type ResetMap = { worldSeed : int size : Size } type PrintMap = struct end type StepSim = struct end type CommitMap = struct end module ResetMap = let defaultParams = { worldSeed = 1 size = { w = 32; h = 32 } } // map cell components [] type Terrain = | Grassland | Desert | Mountains [] type Ore = | Iron | Gold [] type Climate = { temperature : int humidity : int } [] type City = { population : int } [] type Occupant = { unitEid : Eid } module Occupant = let none = { unitEid = Eid.Undefined } // entity components [] type UnitType = | Swordsmen | Archers [] type UnitSize = { unitSize : int } // storage type WorldGrid() = let store = ComponentStore() let mutable size = { w = 0; h = 0 } member c.Size = size member c.Reset newSize = size <- newSize store.Clear() member c.Get(p) = Entity<_,_,_>(p, store) member c.Commit() = let locs = store.GetSegments() store.Segments.ApplyRemovalsFrom(locs) store.Commit() interface ISegmentStore with member c.GetSegments() = store.GetSegments() member c.Handle(param, handler) = store.Handle(param, handler) member c.Handle(param, sid, mask, handler) = store.Handle(param, sid, mask, handler) override c.ToString() = store.ToString() // systems module MapSystem = let register (c : Container) = let map = c.Get() Disposable.Create [ c.On <| fun _ -> map.Commit() c.On <| fun e -> let rand = Random(e.worldSeed) // create map cells map.Reset e.size for y = 0 to e.size.h - 1 do for x = 0 to e.size.w - 1 do let cell = map.Get { x = x; y = y} cell.Add { temperature = rand.Next(0, 100) humidity = rand.Next(0, 100) } cell.Add Grassland if rand.Next(10) = 0 then cell.Add Iron if rand.Next(20) = 0 then cell.Add { population = rand.Next(1, 10) } // add units/entities into map c.DestroyAll() for i = 1 to 50 do // Pick a random location in map. // Note we aren't checking for collisions. Changes are // not immediately applied, so we can't rely on map // itself and would need another way to track. let loc = { x = rand.Next(e.size.w) y = rand.Next(e.size.w) } let entity = c.Create() .With(loc) .With(Swordsmen) .With({ unitSize = rand.Next(1, 10)}) // add (cached) reference to entity in map the entity // loc is the source of truth, so we'll need to keep // map synchronized with it. map.Get(loc).Add { unitEid = entity.Id } c.On ( // Each sim step, increase the temperature of all // cells with iron. Cells can be iterated over the // same way as non-grid entities. fun _ struct(cl : Climate, _ : Ore) -> { cl with temperature = cl.temperature + 1 } |> Join.update2 |> Join.over map) c.On <| fun _ -> let sb = StringBuilder() for y = 0 to map.Size.h - 1 do for x = 0 to map.Size.w - 1 do let cell = map.Get { x = x; y = y} let occupant = cell.GetOrDefault(Occupant.none) let ch = if occupant.unitEid.IsDefined then '!' elif cell.Has() then '$' else match cell.Get() with | Grassland -> '.' | Desert -> 'd' | Mountains -> 'm' sb.Append ch |> ignore sb.AppendLine() |> ignore printfn "%s" (sb.ToString()) ] // startup let run() = let c = Container.Create(MapSystem.register) c.Run { worldSeed = 1 size = { w = 20; h = 20 } } c.Run <| StepSim() c.Run <| PrintMap() // print all components printfn "%s" <| c.ToString() // print a single unit printfn "%s" <| c.Get(Eid 64).ToString() // print a single grid cell let cell = c.Get().Get({ x = 10; y = 15 }) printfn "%s" <| cell.ToString() // destroy cell cell.Destroy() c.Commit() c.Run <| CommitMap() printfn "%s" <| cell.ToString()