WebGPU F# Silk.NET Quad

WebGPU.Quad.fs

module WebGPU
// <ItemGroup>
//     <PackageReference Include="Silk.NET.GLFW" Version="2.20.0" />
//     <PackageReference Include="Silk.NET.WebGPU" Version="2.20.0" />
//     <PackageReference Include="Silk.NET.WebGPU.Native.WGPU" Version="2.20.0" />
//     <PackageReference Include="Silk.NET.Windowing" Version="2.20.0" />
// </ItemGroup>


open Microsoft.FSharp.NativeInterop
open Silk.NET.Core.Native
open Silk.NET.Maths
open Silk.NET.WebGPU
open Silk.NET.Windowing

let mutable options = WindowOptions.Default
options.API <- GraphicsAPI.None
options.Size <- Vector2D(640, 480)
options.FramesPerSecond <- 60
options.UpdatesPerSecond <- 60
options.Position <- Vector2D(400, 400)
options.Title <- "WebGPU Demo"
options.IsVisible <- true
options.ShouldSwapAutomatically <- false
options.IsContextControlDisabled <- false
let shader = """
struct output {
    @builtin(position) position: vec4f,
    @location(0) xy: vec2f,
};
@vertex
// fn vs_main(@builtin(vertex_index) in_vertex_index: u32) -> @builtin(position) vec4<f32> {
fn vs_main(@builtin(vertex_index) in_vertex_index: u32) -> output {
    var pos = array<vec2f, 6>(
        vec2f(-1.0, 1.0),
        vec2f(-1.0, -1.0),
        vec2f(1.0, -1.0),
        
        vec2f(1.0, 1.0),
        vec2f(-1.0, 1.0),
        vec2f(1.0, -1.0)
    );
    var color = array<vec4f, 6>(
        vec4f(1.0, 0.0, 0.0, 1.0), // red
        vec4f(0.0, 1.0, 0.0, 1.0), // green
        vec4f(0.0, 0.0, 1.0, 1.0), // blue
        vec4f(0.0, 1.0, 0.0, 1.0), // green
        vec4f(1.0, 0.0, 0.0, 1.0), // red
        vec4f(0.0, 0.0, 1.0, 1.0), // blue
    );
    let x = f32(i32(in_vertex_index) - 1);
    let y = f32(i32(in_vertex_index & 1u) * 2 - 1);
    
    var vsOutput: output;
    vsOutput.position = vec4f(pos[in_vertex_index], 0.0, 1.0);
    vsOutput.xy = vsOutput.position.xy;
    return vsOutput;
}
// fn fs_main(@builtin(position) p: vec4<f32>) -> @location(0) vec4<f32> {
@fragment
fn fs_main(fsInput: output) -> @location(0) vec4<f32> {
    return vec4(0.0, (fsInput.xy.xy + vec2(1.0, 1.0)) / 2.0, 1.0);
}
"""

let mutable wgpu = Unchecked.defaultof<WebGPU>
let mutable nativeInstance = Unchecked.defaultof<nativeptr<Instance>>
let mutable surface = Unchecked.defaultof<nativeptr<Surface>>
let mutable surfaceConfig = Unchecked.defaultof<SurfaceConfiguration>
let mutable surfaceCapabilities = Unchecked.defaultof<SurfaceCapabilities>
let mutable adapter = Unchecked.defaultof<nativeptr<Adapter>>
let mutable device = Unchecked.defaultof<nativeptr<Device>>
let mutable shaderModule = Unchecked.defaultof<nativeptr<ShaderModule>>
let mutable renderPipeline = Unchecked.defaultof<nativeptr<RenderPipeline>>
let mutable changingVertexBuffer = Unchecked.defaultof<nativeptr<_>>
let window = Window.Create options
let swap () =
    // Create swap
    surfaceConfig <- new SurfaceConfiguration(
        Usage = TextureUsage.RenderAttachment,
        Format = NativePtr.read surfaceCapabilities.Formats,
        PresentMode = PresentMode.Fifo,
        Device = device,
        Width = uint window.FramebufferSize.X,
        Height = uint window.FramebufferSize.Y
    )
    wgpu.SurfaceConfigure(surface, &surfaceConfig)
let onWindowLoad () =
    wgpu <- WebGPU.GetApi ()
    let descriptor = InstanceDescriptor()
    nativeInstance <- wgpu.CreateInstance(&descriptor)
    surface <- window.CreateWebGPUSurface(wgpu, nativeInstance)
    // get adapter
    let request = RequestAdapterOptions(CompatibleSurface = surface)
    let callback = new PfnRequestAdapterCallback(RequestAdapterCallback(fun _ adapter1 _ _ ->
        adapter <- adapter1
    ))
    wgpu.InstanceRequestAdapter(nativeInstance, &request, callback, Unchecked.defaultof<_>)
    // Get device
    let callback = new PfnDeviceLostCallback(DeviceLostCallback(fun reason arg1 arg2 -> ()))
    let descriptor = DeviceDescriptor(DeviceLostCallback = callback)
    let callback = new PfnRequestDeviceCallback(RequestDeviceCallback(fun _ device1 _ _ -> device <- device1))
    wgpu.AdapterRequestDevice(adapter, &descriptor, callback, Unchecked.defaultof<_>)
    let mutable wgslDescriptor = ShaderModuleWGSLDescriptor(
        ChainedStruct(SType = SType.ShaderModuleWgsldescriptor),
        NativePtr.ofNativeInt <| SilkMarshal.StringToPtr(shader)
    )
    let shaderModuleDescriptor = ShaderModuleDescriptor(
        NativePtr.ofNativeInt (NativePtr.toNativeInt &&wgslDescriptor)
    )
    shaderModule <- wgpu.DeviceCreateShaderModule(device, &shaderModuleDescriptor)
    wgpu.SurfaceGetCapabilities(surface, adapter, &surfaceCapabilities)
    let mutable blendState = BlendState(
        Color = BlendComponent(
            SrcFactor = BlendFactor.One,
            DstFactor = BlendFactor.Zero,
            Operation = BlendOperation.Add
        ),
        Alpha = BlendComponent(
            SrcFactor = BlendFactor.One,
            DstFactor = BlendFactor.Zero,
            Operation = BlendOperation.Add
        )
    )
    let mutable colorTargetState = ColorTargetState(
        Format = NativePtr.read surfaceCapabilities.Formats,
        Blend = &&blendState,
        WriteMask = ColorWriteMask.All
    )
    let mutable fragmentState = FragmentState(
        ``Module`` = shaderModule,
        TargetCount = unativeint 1,
        Targets = &&colorTargetState,
        EntryPoint = NativePtr.ofNativeInt (SilkMarshal.StringToPtr("fs_main"))
    )
    let renderPipelineDescriptor = RenderPipelineDescriptor(
        Vertex = VertexState(
            Module = shaderModule,
            EntryPoint = NativePtr.ofNativeInt (SilkMarshal.StringToPtr("vs_main"))
        ),
        Primitive = PrimitiveState(
            Topology = PrimitiveTopology.TriangleList,
            StripIndexFormat = IndexFormat.Undefined,
            FrontFace = FrontFace.Ccw,
            CullMode = CullMode.None
        ),
        Multisample = MultisampleState(
            Count = 1u,
            Mask = ~~~0u,
            AlphaToCoverageEnabled = false
        ),
        Fragment = &&fragmentState,
        DepthStencil = Unchecked.defaultof<_>
    )
    let mutable desc = BufferDescriptor(
        Size = 0uL,
        Usage = (BufferUsage.Vertex ||| BufferUsage.CopyDst)
    )
    changingVertexBuffer <- wgpu.DeviceCreateBuffer(device, &&desc)
    renderPipeline  <- wgpu.DeviceCreateRenderPipeline(device, &renderPipelineDescriptor)
    swap ()
    
let onWindowClosing () =
    wgpu.ShaderModuleRelease(shaderModule)
    wgpu.RenderPipelineRelease(renderPipeline)
    wgpu.DeviceRelease(device)
    wgpu.AdapterRelease(adapter)
    wgpu.SurfaceRelease(surface)
    wgpu.InstanceRelease(nativeInstance)
    wgpu.Dispose()
let onUpdate t = ()
let onWindowRender t =
    let mutable texture = SurfaceTexture()
    wgpu.SurfaceGetCurrentTexture(surface, &&texture)
    match texture.Status with
    | SurfaceGetCurrentTextureStatus.Timeout
    | SurfaceGetCurrentTextureStatus.Lost
    | SurfaceGetCurrentTextureStatus.Outdated ->
        wgpu.TextureRelease(texture.Texture)
        swap ()
    | SurfaceGetCurrentTextureStatus.OutOfMemory
    | SurfaceGetCurrentTextureStatus.DeviceLost
    | SurfaceGetCurrentTextureStatus.Force32 ->
        failwith "Error"
    | _ -> ()
    let view = wgpu.TextureCreateView(texture.Texture, Unchecked.defaultof<nativeptr<_>>)
    let encoderDescriptor = CommandEncoderDescriptor()
    let encoder = wgpu.DeviceCreateCommandEncoder(device, &encoderDescriptor)
    let mutable colorAttachment = RenderPassColorAttachment(
        View = view,
        ResolveTarget = Unchecked.defaultof<_>,
        LoadOp = LoadOp.Clear,
        StoreOp = StoreOp.Store,
        ClearValue = Color(0, 1, 0, 1)
    )
    let renderPassDescriptor = RenderPassDescriptor(
        ColorAttachments = &&colorAttachment,
        ColorAttachmentCount = unativeint 1,
        DepthStencilAttachment = Unchecked.defaultof<nativeptr<RenderPassDepthStencilAttachment>>
    )
    let renderPass = wgpu.CommandEncoderBeginRenderPass(encoder, &renderPassDescriptor)
    wgpu.RenderPassEncoderSetPipeline(renderPass, renderPipeline)
    
    let mutable queue = wgpu.DeviceGetQueue(device)
    
    wgpu.RenderPassEncoderDraw(renderPass, 6u, 2u, 0u, 0u)
    wgpu.RenderPassEncoderEnd(renderPass)
    let cbd = CommandBufferDescriptor()
    let mutable buffer = wgpu.CommandEncoderFinish(encoder, &cbd)
    wgpu.QueueSubmit(queue, unativeint 1, &&buffer)
    wgpu.SurfacePresent(surface)
    wgpu.CommandBufferRelease(buffer)
    wgpu.CommandEncoderRelease(encoder)
    wgpu.TextureViewRelease(view)
    wgpu.TextureRelease(texture.Texture)
    
let onFramebufferResize size =
    swap()
    
window.add_Load onWindowLoad
window.add_Closing onWindowClosing
window.add_Update onUpdate
window.add_Render onWindowRender
window.add_FramebufferResize onFramebufferResize
window.Run()