packages feed

mischief-render (empty) → 0.1.0.0

raw patch · 61 files changed

+10612/−0 lines, 61 filesdep +JuicyPixelsdep +JuicyPixels-extradep +async

Dependencies added: JuicyPixels, JuicyPixels-extra, async, base, binary, bytestring, containers, data-default, kdl-hs, linear, mischief-assets, mischief-ecs, mischief-input, mischief-math, mischief-render, mischief-sdl, mmap, mtl, primitive, sdl3-bindgen-sys, singletons, singletons-base, singletons-th, stm, store, template-haskell, text, time, transformers, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for mischief++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2026, Damon+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the copyright holder nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,17 @@+# mischief-render ++This library adds rendering (via WGPU) to Mischief. It lets you write low-level shader code directly in Haskell monads and seamlessly bind GPU data and run custom materials. It also provides built-in API for Cameras, Sprites and Animations. ++This library lives in the official [repo](https://codeberg.org/mischief/mischief) and is considered a "core library" of the ecosystem. ++To contribute, you can file issues, such as bug reports and feature requests, in the official [repository](https://codeberg.org/mischief/mischief).+You can also join the official server on discord to be kept up to date with updates and chat with the rest of the community. Link in the aforementioned repo. ++You can go through the official rendering book at the `Mischief.Render` module above.  ++### Disclaimer++The API is mostly limited to 2D (although 3D is possible and will be supported oficially in the future).++Many performance optimizations and features have been intentionally ommitted for now. The plan is to have+a small stable core that will be expanded over time.
+ cbits/wrapper.c view
@@ -0,0 +1,71 @@+#include "wrapper.h"+#include "webgpu.h"+#include <stdio.h>+// #include <unistd.h>++struct adapterBox {+  WGPUAdapter adapter; +};++struct deviceBox {+  WGPUDevice device; +};+++static void handle_request_adapter(WGPURequestAdapterStatus status,+                                   WGPUAdapter adapter, WGPUStringView message,+                                   void *userdata1, void *userdata2) {++  if (status == WGPURequestAdapterStatus_Success) {+    struct adapterBox *box = userdata1;+    box->adapter = adapter;+  } else {+    printf(" request_adapter status=%#.8x message=%.*s\n", status,+           (int) message.length, message.data);+  }+}++static void handle_request_device(WGPURequestDeviceStatus status,+                                  WGPUDevice device, WGPUStringView message,+                                  void *userdata1, void *userdata2) {+  if (status == WGPURequestDeviceStatus_Success) {+    struct deviceBox *box = userdata1;+    box->device = device;+  } else {+    printf(" request_device status=%#.8x message=%.*s\n", status,+           (int) message.length, message.data);+  }+}++WGPUDevice hs_wgpuAdapterRequestDevice(+    WGPUAdapter adapter+) {+    struct deviceBox deviceBox = {0};++    wgpuAdapterRequestDevice(adapter, NULL, +                          (const WGPURequestDeviceCallbackInfo){ +                              .callback = handle_request_device,+                              .userdata1 = &deviceBox+                          });+    // sleep(2);+    return deviceBox.device;+}++WGPUAdapter hs_wgpuInstanceRequestAdapter(+  WGPUInstance instance, +  WGPUSurface surface+) {+    struct adapterBox adapterBox = {0};++    wgpuInstanceRequestAdapter(instance,+      &(const WGPURequestAdapterOptions){+          .compatibleSurface = surface,+      },+      (const WGPURequestAdapterCallbackInfo){+          .callback = handle_request_adapter,+          .userdata1 = &adapterBox +      });+    +    // sleep(2);+    return adapterBox.adapter;+}
+ examples/Animation.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void, when)+import Control.Monad.IO.Class+import Data.Data (Proxy (..))+import Data.Default+import Data.Foldable+import Data.IORef+import Data.Text (Text)+import Mischief.Animation (AnimationPlugin, Animator (..), input, shift)+import Mischief.Animation.Animations (selAnim)+import Mischief.Animation.Animator qualified as A+import Mischief.Animation.Spritesheet (Animation (..), noAnimation)+import Mischief.Assets+import Mischief.Assets.Image+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Input (InputPlugin)+import Mischief.Input.Keys (Keys)+import Mischief.Input.Keys qualified as Keys+import Mischief.Materials.Sprite+import Mischief.Math hiding (qd)+import Mischief.Math.Transform (Transform (..))+import Mischief.Math.Transform qualified as Transform+import Mischief.Render.Buffer+import Mischief.Render.Camera+import Mischief.Render.Core (RenderDevice, RenderQueue, RenderUpdate)+import Mischief.Render.Material (WithMaterial (WithMaterial), renderMaterial)+import Mischief.Render.Plugin+import Mischief.Render.Sprite.Common+import Mischief.SDL.Window++main :: IO ()+main = do+  app <- newApp+  setAssetSource "assets" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    systems setup+      & schedule @Startup++    systems moveSprite+      & schedule @Update++    systems (renderMaterial @CustomMat def)+      & schedule @RenderUpdate++  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @FileWatcherPlugin]++setup :: System ()+setup = do+  void $ load @Image "characters.png"++  window <- spawn (Name "Window", Window, WindowFlags [WindowResizable])+  void $ spawn (Camera, Rel OutputTo window)++  let positions = [V2 0 0, V2 (-1) 0, V2 1 0, V2 0 1, V2 0 (-1)]+  let characters = [Pink, Beige, Green, Purple, Yellow]++  for_ (positions `zip` characters) $ \(V2 x y, c) -> do+    let spritePos = V3 (x * 150) (y * 150) (-1)+    e <-+      spawn+        ( Animator MyAnimator,+          def {translation = spritePos},+          WithMaterial @CustomMat+        )++    Just device <- res @RenderDevice+    Just queue <- res @RenderQueue+    buffer <- createBuffer @SomeColor device+    insert buffer e+    uploadBuffer queue buffer (SomeColor {color = V3 1 0 0})++    shift (ChangeCharacter c) e++moveSprite :: System ()+moveSprite = do+  sprites <- query [q|E, Transform / With Sprite|]+  Just keys <- res @Keys++  for_ sprites $ \(entity, sprite) -> do+    when (Keys.justPressed keys Keys.Space) $ shift DoJump entity++    delta <- Time.delta+    let speed = 150++    dir <- liftIO $ newIORef (V2 0 0)++    when (Keys.pressed keys Keys.A) $ do+      liftIO $ modifyIORef' dir (+ V2 (-1) 0)++    when (Keys.pressed keys Keys.D) $ do+      liftIO $ modifyIORef' dir (+ V2 1 0)++    when (Keys.pressed keys Keys.S) $ do+      liftIO $ modifyIORef' dir (+ V2 0 (-1))++    when (Keys.pressed keys Keys.W) $ do+      liftIO $ modifyIORef' dir (+ V2 0 1)++    dir <- liftIO $ (^* (delta * speed)) . normalize <$> readIORef dir++    let walk = norm dir > 0+    input @MyAnimator (\x -> x {walk}) entity++    if+      | dir.x < 0 -> insert SpriteFlip {x = True, y = False} entity+      | dir.x > 0 -> insert SpriteFlip {x = False, y = False} entity+      | otherwise -> pure ()++    insert (Transform.move (V3 dir.x dir.y 0) sprite) entity++data Character = Pink | Purple | Green | Beige | Yellow deriving (Component, Show, Eq)++characterName :: Character -> Text+characterName Pink = "pink"+characterName Beige = "beige"+characterName Purple = "purple"+characterName Green = "green"+characterName Yellow = "yellow"++data MyAnimator = MyAnimator++data CharacterAnimation = Idle | Walk | Jump++instance A.AnimatorTag MyAnimator where+  data State MyAnimator = Start | CA Character CharacterAnimation+  data Input MyAnimator = I {walk :: Bool} deriving (Generic, Default)+  data Shift MyAnimator = ChangeCharacter Character | DoJump++  animation :: A.State MyAnimator -> AssetRef Animation+  animation (CA x Jump) = selAnim "animations.kdl" (characterName x <> "_jump")+  animation (CA x Idle) = selAnim "animations.kdl" (characterName x <> "_idle")+  animation (CA x Walk) = selAnim "animations.kdl" (characterName x <> "_walk")+  animation Start = noAnimation++  transition Start _ (Just (ChangeCharacter x)) _ = Just $ CA x Idle+  transition (CA x _) _ (Just DoJump) _ = Just $ CA x Jump+  transition (CA x Jump) _ _ _ = Just $ CA x Idle+  transition (CA x Walk) (I {walk = False}) _ _ = Just $ CA x Idle+  transition (CA x Idle) (I {walk = True}) _ _ = Just $ CA x Walk+  transition _ _ _ _ = Nothing++  start = Start
+ examples/Transform.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE MultiWayIf #-}++module Main where++import Control.Monad (void)+import Data.Text (Text)+import Mischief.Animation+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Input+import Mischief.Input.Keys qualified as Keys+import Mischief.Materials.Sprite (SpriteMaterial)+import Mischief.Math+import Mischief.Math.Transform qualified as Transform+import Mischief.Render++main :: IO ()+main = do+  app <- newApp+  setAssetSource "assets" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    systems setup+      & schedule @Startup++    systems move+      & schedule @Update++    systems (renderMaterial @SpriteMaterial def)+      & schedule @RenderUpdate++  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @TransformPlugin]++data Player = Player deriving (Component)++data SecondPlayer = SecondPlayer deriving (Component)++setup :: System ()+setup = do+  void $ load @Image "characters.png"++  window <- spawn (Name "Window", Window, WindowFlags [WindowResizable])+  void $ spawn (Camera, Rel OutputTo window)++  pink <-+    spawn+      ( Animator MyAnimator,+        WithMaterial @SpriteMaterial,+        Player+      )+  shift (ChangeCharacter Pink) pink++  green <-+    spawn+      ( Animator MyAnimator,+        WithMaterial @SpriteMaterial,+        def {translation = V3 50 50 0},+        Rel ChildOf pink,+        SecondPlayer+      )+  shift (ChangeCharacter Green) green++  spawn+    ( Animator MyAnimator,+      WithMaterial @SpriteMaterial,+      def {translation = V3 100 100 0},+      Rel ChildOf green+    )+    >>= shift (ChangeCharacter Beige)++move :: System ()+move = do+  Just keys <- res @Keys+  Just (entity, sprite) <-+    if not $ Keys.pressed keys Keys.LShift+      then+        single [q|E, Transform / With Sprite, With Player|]+      else+        single [q|E, Transform / With Sprite, With SecondPlayer|]++  delta <- Time.delta+  let speed = 150++  let dirX =+        if+          | Keys.pressed keys Keys.A -> V2 (-1) 0+          | Keys.pressed keys Keys.D -> V2 1 0+          | otherwise -> V2 0 0++  let dirY =+        if+          | Keys.pressed keys Keys.S -> V2 0 (-1)+          | Keys.pressed keys Keys.W -> V2 0 1+          | otherwise -> V2 0 0++  let dir = normalize (dirX + dirY) ^* delta * speed++  let rotation =+        if+          | Keys.pressed keys Keys.Q -> 0.5 * delta+          | Keys.pressed keys Keys.E -> -(0.5 * delta)+          | otherwise -> 0++  insertIfNeq (Transform.rotateZ rotation $ Transform.move (V3 dir.x dir.y 0) sprite) entity++data Character = Pink | Purple | Green | Beige | Yellow deriving (Component, Show, Eq)++characterName :: Character -> Text+characterName Pink = "pink"+characterName Beige = "beige"+characterName Purple = "purple"+characterName Green = "green"+characterName Yellow = "yellow"++data MyAnimator = MyAnimator++data CharacterAnimation = Idle | Walk | Jump++instance AnimatorTag MyAnimator where+  data State MyAnimator = Start | CA Character CharacterAnimation+  data Input MyAnimator = I {walk :: Bool} deriving (Generic, Default)+  data Shift MyAnimator = ChangeCharacter Character | DoJump++  animation (CA x Jump) = selAnim "animations.kdl" (characterName x <> "_jump")+  animation (CA x Idle) = selAnim "animations.kdl" (characterName x <> "_idle")+  animation (CA x Walk) = selAnim "animations.kdl" (characterName x <> "_walk")+  animation Start = noAnimation++  transition Start _ (Just (ChangeCharacter x)) _ = Just $ CA x Idle+  transition (CA x _) _ (Just DoJump) _ = Just $ CA x Jump+  transition (CA x Jump) _ _ _ = Just $ CA x Idle+  transition (CA x Walk) (I {walk = False}) _ _ = Just $ CA x Idle+  transition (CA x Idle) (I {walk = True}) _ _ = Just $ CA x Walk+  transition _ _ _ _ = Nothing++  start = Start
+ examples/YSort.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void, when)+import Data.Default+import Data.Foldable+import Data.Text (Text)+import Mischief.Animation (AnimationPlugin, Animator (..), input, shift)+import Mischief.Animation.Animations (selAnim)+import Mischief.Animation.Animator qualified as A+import Mischief.Animation.Spritesheet (Animation (..), noAnimation)+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Input (InputPlugin)+import Mischief.Input.Keys (Keys)+import Mischief.Input.Keys qualified as Keys+import Mischief.Materials.Sprite+import Mischief.Math hiding (qd)+import Mischief.Math.Transform qualified as Transform+import Mischief.Render.Camera+import Mischief.Render.Core (RenderUpdate)+import Mischief.Render.Material (WithMaterial (WithMaterial), renderSortedMaterial)+import Mischief.Render.Plugin+import Mischief.Render.Sprite.Common+import Mischief.SDL.Window++main :: IO ()+main = do+  app <- newApp+  setAssetSource "assets" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    systems setup+      & schedule @Startup++    systems moveSprite+      & schedule @Update++    systems (renderSortedMaterial @SpriteMaterial def getSpriteKey)+      & schedule @RenderUpdate++  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @FileWatcherPlugin]++getSpriteKey :: Entity -> Query System Float+getSpriteKey sprite = do+  transform <- qget sprite [qd|Transform|]+  pure $ -transform.translation.y++setup :: System ()+setup = do+  void $ load @Image "characters.png"++  window <- spawn (Name "Window", Window, WindowFlags [WindowResizable])+  void $ spawn (Camera, Rel OutputTo window)++  spawn+    ( Animator MyAnimator,+      def {translation = V3 (-100) (-100) (-1)},+      Anchor $ V2 0.5 1,+      WithMaterial @SpriteMaterial+    )+    >>= shift (ChangeCharacter Beige)++  spawn+    ( Animator MyAnimator,+      def {translation = V3 100 100 (-1)},+      Anchor $ V2 0.5 1,+      WithMaterial @SpriteMaterial+    )+    >>= shift (ChangeCharacter Green)++  spawn+    ( Animator MyAnimator,+      def {translation = V3 100 (-100) (-1)},+      Anchor $ V2 0.5 1,+      WithMaterial @SpriteMaterial+    )+    >>= shift (ChangeCharacter Purple)++  spawn+    ( Animator MyAnimator,+      def {translation = V3 (-100) 100 (-1)},+      Anchor $ V2 0.5 1,+      WithMaterial @SpriteMaterial+    )+    >>= shift (ChangeCharacter Yellow)++  spawn+    ( Animator MyAnimator,+      def {translation = V3 0 0 (-1), scale = V3 1 1 1},+      Anchor $ V2 0.5 1,+      WithMaterial @SpriteMaterial,+      Player+    )+    >>= shift (ChangeCharacter Pink)++data Player = Player deriving (Component)++moveSprite :: System ()+moveSprite = do+  sprite <- query [q|E, Transform / With Player|]+  Just keys <- res @Keys++  for_ sprite $ \(entity, sprite) -> do+    when (Keys.justPressed keys Keys.Space) $ shift DoJump entity++    delta <- Time.delta+    let speed = 150++    let dirX =+          if+            | Keys.pressed keys Keys.A -> V2 (-1) 0+            | Keys.pressed keys Keys.D -> V2 1 0+            | otherwise -> V2 0 0++    let dirY =+          if+            | Keys.pressed keys Keys.S -> V2 0 (-1)+            | Keys.pressed keys Keys.W -> V2 0 1+            | otherwise -> V2 0 0++    let dir = normalize (dirX + dirY) ^* delta * speed++    let walk = norm dir > 0+    input @MyAnimator (\x -> x {walk}) entity++    if+      | dir.x < 0 -> insert SpriteFlip {x = False, y = True} entity+      | dir.x > 0 -> insert SpriteFlip {x = False, y = False} entity+      | otherwise -> pure ()++    let rotation =+          if+            | Keys.pressed keys Keys.Q -> 0.5 * delta+            | Keys.pressed keys Keys.E -> -(0.5 * delta)+            | otherwise -> 0++    insert (Transform.rotateZ rotation $ Transform.move (V3 dir.x dir.y 0) sprite) entity++data Character = Pink | Purple | Green | Beige | Yellow deriving (Component, Show, Eq)++characterName :: Character -> Text+characterName Pink = "pink"+characterName Beige = "beige"+characterName Purple = "purple"+characterName Green = "green"+characterName Yellow = "yellow"++data MyAnimator = MyAnimator++data CharacterAnimation = Idle | Walk | Jump++instance A.AnimatorTag MyAnimator where+  data State MyAnimator = Start | CA Character CharacterAnimation+  data Input MyAnimator = I {walk :: Bool} deriving (Generic, Default)+  data Shift MyAnimator = ChangeCharacter Character | DoJump++  animation :: A.State MyAnimator -> AssetRef Animation+  animation (CA x Jump) = selAnim "animations.kdl" (characterName x <> "_jump")+  animation (CA x Idle) = selAnim "animations.kdl" (characterName x <> "_idle")+  animation (CA x Walk) = selAnim "animations.kdl" (characterName x <> "_walk")+  animation Start = noAnimation++  transition Start _ (Just (ChangeCharacter x)) _ = Just $ CA x Idle+  transition (CA x _) _ (Just DoJump) _ = Just $ CA x Jump+  transition (CA x Jump) _ _ _ = Just $ CA x Idle+  transition (CA x Walk) (I {walk = False}) _ _ = Just $ CA x Idle+  transition (CA x Idle) (I {walk = True}) _ _ = Just $ CA x Walk+  transition _ _ _ _ = Nothing++  start = Start
+ examples/postprocess/Material.hs view
@@ -0,0 +1,38 @@+module Material where++import Mischief.Materials+import Mischief.Materials.Fullscreen (FullscreenMaterial)+import Mischief.Materials.Fullscreen qualified as Fullscreen+import Mischief.Render.Camera (cameraSwapView)+import Mischief.Render.Core+import Prelude ()++data PostprocessMaterial++data Bindings f = Bindings+  { texture :: Binding f Texture,+    sampler :: Binding f Sampler+  }+  deriving (Generic, Bindable)++instance Material PostprocessMaterial where+  type VI PostprocessMaterial = Fullscreen.VertexInput+  type VO PostprocessMaterial = Fullscreen.VertexOutput+  type B PostprocessMaterial = Bindings++  type Extends PostprocessMaterial = '[FullscreenMaterial]++  vertex = liftExt . vertex @FullscreenMaterial+  fragment vo = do+    Bindings {texture, sampler} <- bindings+    pure $ sample texture sampler vo.uv * vec4 1 0 0 1++  fetch =+    FetchBindings+      ( \camera -> do+          (DefaultSampler sampler) <- qres @DefaultSampler+          texture <- cameraSwapView camera+          pure (sampler, texture)+      )+      (const $ pure ())+      (\(sampler, texture) _ -> Bindings texture sampler)
+ examples/postprocess/Postprocess.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Data.Default+import Material+import Mischief.Animation (AnimationPlugin)+import Mischief.Assets+import Mischief.Assets.Image+import Mischief.ECS+import Mischief.Input (InputPlugin)+import Mischief.Materials.Fullscreen (FullscreenMaterial)+import Mischief.Materials.Sprite (SpriteMaterial)+import Mischief.Math hiding (qd)+import Mischief.Math.Transform (Transform (..))+import Mischief.Render.Camera+import Mischief.Render.Core (RenderPostprocess, RenderUpdate)+import Mischief.Render.Material (WithMaterial (WithMaterial), renderMaterial)+import Mischief.Render.Material.Definition (RenderOptions (..))+import Mischief.Render.Plugin+import Mischief.Render.Sprite.Common+import Mischief.SDL.Window++main :: IO ()+main = do+  app <- newApp+  setAssetSource "assets" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    systems setup+      & schedule @Startup++    systems renderPostprocess+      & schedule @RenderUpdate++    systems renderSprites+      & schedule @RenderUpdate++  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @FileWatcherPlugin]++renderPostprocess :: System ()+renderPostprocess = renderMaterial @PostprocessMaterial def {nvertices = 4}++renderSprites :: System ()+renderSprites = renderMaterial @SpriteMaterial def++setup :: System ()+setup = do+  image <- load @Image "characters.png"+  window <- spawn (Name "Window", Window, WindowFlags [WindowResizable])++  void $ spawn (Camera, Rel OutputTo window, WithMaterial @PostprocessMaterial)++  void $+    spawn+      ( Sprite {image},+        def {translation = V3 0 0 0},+        SpriteSlice (V2 0 387) (V2 128 128),+        WithMaterial @SpriteMaterial+      )
+ examples/start/MyMaterial.hs view
@@ -0,0 +1,35 @@+module MyMaterial where++import Mischief.Materials+import Mischief.Materials.Sprite qualified as Sprite+import Prelude ()++newtype MyColor f = MyColor (Field f (Vec3 Float)) deriving (Generic, Bufferable)++instance Component (MyColor CPU)++newtype Bindings f = Bindings (Uniform f (MyColor f)) deriving (Generic, Bindable)++data MyMaterial++instance Material MyMaterial where+  type VI MyMaterial = Sprite.VertexInput+  type VO MyMaterial = Sprite.VertexOutput++  type B MyMaterial = Bindings++  type Extends MyMaterial = '[Sprite.SpriteMaterial]++  vertex = liftExt . (vertex @Sprite.SpriteMaterial)++  fragment vo = do+    color <- liftExt $ Sprite.sampleSprite vo.uv+    Bindings (MyColor myColor) <- bindings+    pure $ (myColor * color.rgb) +: color.a++  fetch =+    FetchBindings+      { camera = \_ -> pure (),+        mesh = \sprite -> qget sprite [qd|(Buffer MyColor)|],+        result = \_ color -> Bindings color+      }
+ examples/start/Start.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Data.Default+import Data.Text (Text)+import Mischief.Animation+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Input+import Mischief.Input.Keys qualified as Keys+import Mischief.Math hiding (qd)+import Mischief.Math.Transform qualified as Transform+import Mischief.Render+import MyMaterial (MyColor (..), MyMaterial)++main :: IO ()+main = do+  app <- newApp+  setAssetSource "assets/" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    systems setup+      & schedule @Startup++    systems (movement, maintainBuffer @MyColor)+      & schedule @RenderPrepare++    systems (renderSortedMaterial @MyMaterial def getY)+      & schedule @RenderUpdate++  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @FileWatcherPlugin]++data Player = Player deriving (Component)++getY :: Entity -> Query System Float+getY entity = do+  Transform {translation} <- [q|entity. Transform|]+  pure (-translation.y)++setup :: System ()+setup = do+  window <- spawn Window+  void $ spawn (Camera, Rel OutputTo window)++  e <-+    spawn+      ( Animator MyAnimator,+        Anchor $ V2 0.5 0.9,+        WithMaterial @MyMaterial,+        def {translation = V3 (-60) 0 0},+        MyColor @CPU (V3 1 1 0),+        Player+      )++  shift (ChangeCharacter Pink) e++  e <-+    spawn+      ( Animator MyAnimator,+        Anchor $ V2 0.5 0.9,+        WithMaterial @MyMaterial,+        MyColor @CPU (V3 0 1 1),+        def {translation = V3 60 0 0}+      )++  shift (ChangeCharacter Green) e++movement :: System ()+movement = do+  Just keys <- res @Keys+  Just (player, transform) <- single [q|Entity, Transform / With Player|]++  delta <- Time.delta+  let speed = 150++  let dirX =+        if+          | Keys.pressed keys Keys.A -> -1+          | Keys.pressed keys Keys.D -> 1+          | otherwise -> 0++  let dirY =+        if+          | Keys.pressed keys Keys.S -> -1+          | Keys.pressed keys Keys.W -> 1+          | otherwise -> 0++  let dir = normalize $ V3 dirX dirY 0++  let walk = norm dir > 0+  input @MyAnimator (\i -> i {walk}) player++  let flip = dir.x < 0+  insert (SpriteFlip {x = False, y = flip}) player++  insert (Transform.move (dir ^* delta * speed) transform) player++data MyAnimator = MyAnimator++data Character = Green | Pink++charName :: Character -> Text+charName Green = "green"+charName Pink = "pink"++data AnimationType = Idle | Walk++instance AnimatorTag MyAnimator where+  data Input MyAnimator = Input {walk :: Bool} deriving (Generic, Default)+  data Shift MyAnimator = ChangeCharacter Character+  data State MyAnimator = Start | CharacterAnimation Character AnimationType++  animation (CharacterAnimation c Idle) = selAnim "animations.kdl" (charName c <> "_idle")+  animation (CharacterAnimation c Walk) = selAnim "animations.kdl" (charName c <> "_walk")+  animation Start = noAnimation++  transition (CharacterAnimation c Idle) Input {walk = True} _ _ = Just (CharacterAnimation c Walk)+  transition (CharacterAnimation c Walk) Input {walk = False} _ _ = Just (CharacterAnimation c Idle)+  transition Start _ (Just (ChangeCharacter c)) _ = Just (CharacterAnimation c Idle)+  transition _ _ _ _ = Nothing++  start = Start
+ mischief-render.cabal view
@@ -0,0 +1,427 @@+cabal-version: 3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.+-- Initial package description 'mischief' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name: mischief-render+-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version: 0.1.0.0+-- A short (one-line) description of the package.+-- synopsis:+-- A longer description of the package.+-- description:+-- The license under which the package is released.+license: BSD-3-Clause+-- The file containing the license text.+license-file: LICENSE+-- The package author(s).+author: Damon+-- An email address to which users can send suggestions, bug reports, and patches.+maintainer: pvdoriginal2019@gmail.com+homepage: https://codeberg.org/mischief/mischief+synopsis: Rendering for the Mischief game engine.+description:+  This library provides both low and high-level rendering tools for Mischief. It also comes+  with WGPU bindings, an Animation system, and a few pre-defined Materials.++-- A copyright notice.+-- copyright:+build-type: Simple+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:+  CHANGELOG.md+  README.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:+common warnings+  ghc-options:+    "-Wall,"+    -Wno-name-shadowing++library+  -- Import common warning flags.+  import: warnings+  -- Modules exported by the library.+  exposed-modules:+    Mischief.Animation+    Mischief.Animation.Animations+    Mischief.Animation.Animator+    Mischief.Animation.Spritesheet+    Mischief.Materials+    Mischief.Materials.Fullscreen+    Mischief.Materials.Sprite+    Mischief.Materials.Time+    Mischief.Render+    Mischief.Render.Bind+    Mischief.Render.Buffer+    Mischief.Render.Camera+    Mischief.Render.Core+    Mischief.Render.Image+    Mischief.Render.Layers+    Mischief.Render.Material+    Mischief.Render.Material.Definition+    Mischief.Render.Material.Instance+    Mischief.Render.Material.Pipeline+    Mischief.Render.Plugin+    Mischief.Render.Sprite+    Mischief.Render.Sprite.Common+    Mischief.Render.Texture+    Mischief.Render.TextureFormat+    Mischief.Render.Time+    Mischief.Render.Tutorial.Basics+    Mischief.Render.Tutorial.Materials+    Mischief.Render.Tutorial.Shaders+    Mischief.Render.Tutorial.Start.Animation+    Mischief.Render.Tutorial.Start.Shader+    Mischief.Render.Tutorial.Start.Start+    Mischief.Shader+    Mischief.Shader.Functions+    Mischief.Shader.Generation+    Mischief.Shader.Types+    Mischief.WGPU+    Mischief.WGPU.Callbacks+    Mischief.WGPU.Common+    Mischief.WGPU.Core+    Mischief.WGPU.Framework+    Mischief.WGPU.Opaque+    Mischief.WGPU.Types.Enums+    Mischief.WGPU.Types.General++  other-modules:+    Mischief.Shader.Internal.Bindings+    Mischief.Shader.Internal.Buffers+    Mischief.Shader.Internal.Params+    Mischief.Shader.Internal.Singletons+    Mischief.Shader.Internal.State++  -- Modules included in this library but not exported.+  -- other-modules:+  other-modules:+  -- LANGUAGE extensions used by modules in this package.z+  default-extensions:+    DefaultSignatures+    DeriveAnyClass+    DuplicateRecordFields+    FunctionalDependencies+    ImportQualifiedPost+    MagicHash+    MultiWayIf+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies+    UnboxedTuples+    UndecidableInstances+    UnliftedFFITypes+    UnliftedNewtypes++  -- other-extensions:+  -- Other library packages from which modules are imported.+  build-depends:+    async >=2.2.6 && <2.3,+    base >=4.21.0.0 && <4.22,+    binary >=0.8.9 && <0.9,+    bytestring >=0.12.2 && <0.13,+    containers >=0.7 && <0.8,+    data-default >=0.8.0 && <0.9,+    JuicyPixels >=3.3.9 && <3.4,+    JuicyPixels-extra >=0.6.0 && <0.7,+    kdl-hs >=1.2.1 && <1.3,+    linear >=1.23.3 && <1.24,+    mischief-assets >=0.1.0 && <0.2,+    mischief-ecs >=0.2.1 && <0.3,+    mischief-math >=0.1.0 && <0.2,+    mischief-sdl >=0.1.0 && <0.2,+    mtl >=2.3.1 && <2.4,+    primitive >=0.9.1 && <0.10,+    sdl3-bindgen-sys >=0.0.1 && <0.1,+    singletons >=3.0.4 && <3.1,+    singletons-base >=3.5 && <3.6,+    singletons-th >=3.5 && <3.6,+    stm >=2.5.3 && <2.6,+    template-haskell >=2.23.0 && <2.24,+    text >=2.1.2 && <2.2,+    time >=1.14 && <1.15,+    transformers >=0.6.1 && <0.7,+    vector >=0.13.2 && <0.14,++  build-tool-depends:+    hsc2hs:hsc2hs++  -- pkgconfig-depends:+  --   wgpu-native+  -- Directories containing source files.+  hs-source-dirs:+    src++  include-dirs:+    cbits/++  extra-libraries:+    wgpu_native++  c-sources:+    cbits/wrapper.c++  pkgconfig-depends:+    sdl3++  -- Base language which the package is written in.+  default-language:+    GHC2024++  ghc-options: -fno-omit-yields++test-suite mischief-test+  -- Import common warning flags.+  import: warnings+  ghc-options: -fno-omit-yields+  -- Base language which the package is written in.+  default-language: GHC2024+  -- Modules included in this executable, other than Main.+  -- other-modules:+  -- LANGUAGE extensions used by modules in this package.+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    ForeignFunctionInterface+    ImportQualifiedPost+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    QuasiQuotes+    RequiredTypeArguments+    TypeFamilyDependencies++  -- other-extensions:+  -- The interface type and version of the test suite.+  type: exitcode-stdio-1.0+  -- Directories containing source files.+  hs-source-dirs: test+  -- The entrypoint to the test suite.+  main-is: Main.hs+  -- Test dependencies.+  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    JuicyPixels,+    JuicyPixels-extra,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    mmap,+    primitive,+    sdl3-bindgen-sys,+    store,+    text,+    transformers,+    vector,++executable example-animation+  main-is: Animation.hs+  hs-source-dirs: examples+  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    primitive,+    sdl3-bindgen-sys,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies++  pkgconfig-depends:+    sdl3++executable example-postprocess+  main-is: Postprocess.hs+  hs-source-dirs: examples/postprocess/+  other-modules:+    Material++  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    primitive,+    sdl3-bindgen-sys,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies++  pkgconfig-depends:+    sdl3++executable example-ysort+  main-is: YSort.hs+  hs-source-dirs: examples/+  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    primitive,+    sdl3-bindgen-sys,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies++  pkgconfig-depends:+    sdl3++executable example-start+  main-is: Start.hs+  hs-source-dirs: examples/start/+  other-modules:+    MyMaterial++  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    primitive,+    sdl3-bindgen-sys,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies++  pkgconfig-depends:+    sdl3++executable example-transform+  main-is: Transform.hs+  hs-source-dirs: examples/+  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    mischief-input,+    mischief-math,+    mischief-render,+    mischief-sdl,+    primitive,+    sdl3-bindgen-sys,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies++  pkgconfig-depends:+    sdl3
+ src/Mischief/Animation.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Animation+  ( Animator (..),+    AnimatorTag (..),+    AnimationPlugin,+    input,+    inputIfNeq,+    shift,+    Animation,+    Animations (..),+    selAnim,+    Spritesheet,+    noAnimation,+  )+where++import Control.Monad+import Data.Data+import GHC.Float (int2Float)+import Mischief.Animation.Animations (Animations (..), selAnim)+import Mischief.Animation.Animator+import Mischief.Animation.Spritesheet+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Render.Sprite.Common++data Animator where+  Animator :: forall a. (AnimatorTag a) => a -> Animator++instance Component Animator where+  onSet =+    [ hook $ \HookContext {entity} -> do+        Just (Animator (_ :: a)) <- single [q|entity. Animator|]+        insert (AnimatorInput (defInput @a)) entity+    ]++data AnimatorInput where+  AnimatorInput :: (Typeable a) => a -> AnimatorInput+  deriving (Component)++newtype AnimationElapsedTime = AnimationElapsedTime Float deriving anyclass (Component)++data CurrentAnimation = CurrentAnimation {animation :: AssetRef Animation, index :: Int} deriving anyclass (Component)++data AnimatorState where+  AnimatorState :: (Typeable a) => a -> AnimatorState+  deriving (Component)++data AnimationPlugin++instance Plugin AnimationPlugin where+  init = do+    spawn_ $ Observer onSetAnimator+    spawn_ $ Observer onSetAnimatorState+    schedule @Update $ systems progressAnimations+    schedule @Update $ systems transitionWhen & after progressAnimations++onSetAnimator :: OnSet Animator -> System ()+onSetAnimator OnSet {entity} = do+  Just (Animator (_ :: anim)) <- single [q|entity. Animator|]+  insert (AnimatorState $ start @anim, CurrentAnimation (animation $ start @anim) 0, AnimationElapsedTime 0) entity++qloadedAnim :: AssetRef Animation -> Query System ()+qloadedAnim anim = do+  Animation {spritesheet} <- qasset' anim+  void $ qasset' $ kdlToAssetRef spritesheet++onSetAnimatorState :: OnSet AnimatorState -> System ()+onSetAnimatorState OnSet {entity} = query_ $ do+  (Animator (_ :: tag), AnimatorState (state :: state)) <- [q|entity. Animator, AnimatorState|]+  case eqT @state @(State tag) of+    Nothing -> qlift $ warn [i|Animator state doesn't match the animator's expected state|]+    Just Refl -> qlift $ setNewAnimation entity (animation @tag state)++setNewAnimation :: Entity -> AssetRef Animation -> System ()+setNewAnimation entity animation' = do+  waitForAnimation animation' $ do+    Just animation <- asset animation'+    case animation of+      Animation {dummy = True} -> do+        insert (AnimationElapsedTime 0, CurrentAnimation noAnimation 0) entity+      animation -> query_ $ do+        slice <- qmaybe =<< qanimFrameCoords 0 animation+        image <- qanimImage animation++        qpure entity+          & qinsert+            ( const+                ( CurrentAnimation animation' 0,+                  AnimationElapsedTime 0,+                  Sprite {image},+                  slice+                )+            )++progressAnimations :: System ()+progressAnimations = query_ $ do+  delta <- Time.qdelta++  (entity, CurrentAnimation {animation = animation', index}, AnimationElapsedTime time) <- [q|Entity, CurrentAnimation, AnimationElapsedTime|]+  animation <- qasset animation'++  Control.Monad.when animation.dummy qstop++  let time' = time + delta+  let frames = nframes animation++  let totalTime = case animation.time of+        FpsTime t -> 1 / t+        TotalTime t -> t / int2Float frames++  Control.Monad.when (time < totalTime) $ do+    qpure entity & qinsert (const $ AnimationElapsedTime time')+    qstop++  image <- qanimImage animation++  slice <- qanimFrameCoords (index + 1) animation+  case slice of+    Nothing -> Control.Monad.when animation.loop $ do+      slice <- qmaybe =<< qanimFrameCoords 0 animation+      qpure entity+        & qinsert+          ( const+              ( CurrentAnimation animation' 0,+                Sprite {image},+                slice,+                AnimationElapsedTime 0+              )+          )+    Just slice -> do+      qpure entity+        & qinsert+          ( const+              ( CurrentAnimation animation' (index + 1),+                Sprite {image},+                slice,+                AnimationElapsedTime 0+              )+          )++input :: forall a. (AnimatorTag a) => (Input a -> Input a) -> Entity -> System ()+input f e = query_ $ do+  AnimatorInput (input :: b) <- [q|e. AnimatorInput|]+  case eqT @b @(Input a) of+    Nothing -> pure () & qwarn (const [i|#{e} doesn't have an animator of type #{typeRep (Proxy @a)}!|])+    Just Refl -> qpure e & qinsert (const $ AnimatorInput $ f input)++inputIfNeq :: forall a. (AnimatorTag a, Eq (Input a)) => (Input a -> Input a) -> Entity -> System ()+inputIfNeq f e = query_ $ do+  AnimatorInput (input :: b) <- [q|e. AnimatorInput|]+  case eqT @b @(Input a) of+    Nothing -> pure () & qwarn (const [i|#{e} doesn't have an animator of type #{typeRep (Proxy @a)}!|])+    Just Refl -> Control.Monad.when (input /= f input) $ qpure e & qinsert (const $ AnimatorInput $ f input)++transitionWhen :: System ()+transitionWhen = query_ $ do+  (e, AnimatorInput (input :: inp), AnimatorState (state :: state), CurrentAnimation {animation = animation', index}, AnimationElapsedTime elapsed, Animator (_ :: tag)) <- [q|E, AnimatorInput, AnimatorState, CurrentAnimation, AnimationElapsedTime, Animator|]++  animation <- qasset animation'+  let frames = nframes animation++  let totalTime = case animation.time of+        FpsTime t -> 1 / t+        TotalTime t -> t / int2Float frames++  let status = if index == frames - 1 && elapsed >= totalTime then Finished else Running++  case eqT @inp @(Input tag) of+    Nothing -> pure () & qwarn (const [i|Animator and Input Type not matching on #{e}|])+    Just Refl -> do+      case eqT @state @(State tag) of+        Nothing -> pure () & qwarn (const [i|Animator and State Type not matching on #{e}|])+        Just Refl -> do+          let x = checkTransitions @tag state input Nothing status+          case x of+            Nothing -> pure ()+            Just state -> qlift $ do+              insert (AnimatorState state) e++waitForAnimation :: AssetRef Animation -> System () -> System ()+waitForAnimation a s = flip runWhenOne (const s) $ do+  a <- qasset a+  qasset $ kdlToAssetRef a.spritesheet++-- whenLoaded' (kdlToAssetRef a.spritesheet) $ const $ do+--   err "ok this also passed.."+--   s++shift :: forall a. (Typeable a) => a -> Entity -> System ()+shift shift e = query_ $ do+  (AnimatorInput (inp :: inp), AnimatorState (state :: state), CurrentAnimation {animation = animation', index}, AnimationElapsedTime elapsed, Animator (_ :: tag)) <- [q|e. AnimatorInput, AnimatorState, CurrentAnimation, AnimationElapsedTime, Animator|]++  animation <- qasset animation'+  let frames = nframes animation++  let totalTime = case animation.time of+        FpsTime t -> 1 / t+        TotalTime t -> t / int2Float frames++  let status = if index == frames - 1 && elapsed >= totalTime then Finished else Running++  case eqT @a @(Shift tag) of+    Nothing -> pure () & qwarn (const [i|Animator type doesn't exist on #{e}|])+    Just Refl -> do+      case eqT @state @(State tag) of+        Nothing -> pure () & qwarn (const [i|Animator and State Type not matching on #{e}|])+        Just Refl -> do+          case eqT @inp @(Input tag) of+            Nothing -> pure () & qwarn (const [i|Animator and Input Type not matching on #{e}|])+            Just Refl -> do+              let x = checkTransitions @tag state inp (Just shift) status+              case x of+                Nothing -> pure ()+                Just state -> qlift $ do+                  insert (AnimatorState state) e
+ src/Mischief/Animation/Animations.hs view
@@ -0,0 +1,31 @@+module Mischief.Animation.Animations where++import Data.Functor ((<&>))+import Data.Text (Text)+import KDL qualified+import Mischief.Animation.Spritesheet+import Mischief.Assets+import Mischief.ECS (Component)++data Animations = Animations {spritesheet :: KdlRef Spritesheet, collection :: KdlCollection Animation} deriving (Show, Component)++instance KdlAsset Animations where+  decodeKdl path = KDL.children $ do+    spritesheet <- KDL.nodeWith "spritesheet" $ decodeKdl path+    collection <- KDL.nodeWith "collection" $ KDL.children $ colDecodeWith $ decodeAnimationWithSpritesheet spritesheet++    pure $ Animations {spritesheet, collection}++instance Asset Animations where+  type Saveable Animations = False+  loadAsset = loadKdl "animations"++decodeAnimationWithSpritesheet :: KdlRef Spritesheet -> KDL.NodeDecoder Animation+decodeAnimationWithSpritesheet spritesheet = KDL.children $ do+  frames <- animationFramesDecoder+  time <- animationTimeDecoder+  loop <- animationLoopDecoder+  pure $ Animation {dummy = False, time, frames, loop, spritesheet}++selAnim :: Text -> Text -> AssetRef Animation+selAnim file anim = Ref @Animations file <&> (colGetU anim . (.collection))
+ src/Mischief/Animation/Animator.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Animation.Animator where++import Data.Data+import Data.Kind (Type)+import Data.Maybe+import GHC.Stack (HasCallStack)+import Mischief.Animation.Spritesheet+import Mischief.Assets+import Mischief.ECS++data AnimationStatus = Finished | Running++class (Typeable (Input a), Typeable a, Typeable (State a), Typeable (Shift a)) => AnimatorTag a where+  data State a :: Type+  data Input a :: Type+  data Shift a :: Type++  transition :: State a -> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)+  transition _ _ _ _ = Nothing++  defInput :: Input a+  default defInput :: (Default (Input a)) => Input a+  defInput = def++  animation :: (HasCallStack) => State a -> AssetRef Animation++  start :: State a++data TransitionType = SoftTransition | HardTransition deriving (Eq)++data Transition state input shift = Transition+  { transType :: TransitionType,+    transTo :: state,+    transCond :: Condition input shift+  }++to :: state -> Condition input shift -> Transition state input shift+to b c = Transition {transType = SoftTransition, transTo = b, transCond = c}++to' :: state -> Condition input shift -> Transition state input shift+to' b c = Transition {transType = HardTransition, transTo = b, transCond = c}++data Condition input shift = WhenCondition (input -> Bool) | ShiftCondition shift++when :: (input -> Bool) -> Condition input shift+when = WhenCondition++on :: shift -> Condition input shift+on = ShiftCondition++type IsFinished = Bool++checkTransitions :: forall a. (AnimatorTag a) => State a -> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)+checkTransitions = transition
+ src/Mischief/Animation/Spritesheet.hs view
@@ -0,0 +1,125 @@+module Mischief.Animation.Spritesheet where++import Control.Applicative+import Data.List (find, (!?))+import Data.Text (Text)+import GHC.Stack+import GHC.TypeLits+import KDL qualified+import Linear (V2 (V2))+import Mischief.Assets+import Mischief.Assets.Image+import Mischief.ECS+import Mischief.ECS.Utils+import Mischief.Render.Sprite+import Mischief.Render.Sprite.Common++data Spritesheet = Spritesheet+  { frameSize :: V2 Int,+    padding :: V2 Int,+    size :: V2 Int,+    image :: AssetRef Image+  }+  deriving (Component, Show)++noSpritesheet :: KdlRef Spritesheet+noSpritesheet = KdlValue $ Spritesheet {frameSize = V2 0 0, padding = V2 0 0, size = V2 0 0, image = NullRef}++sheetCoords :: Int -> Spritesheet -> (V2 Int, V2 Int)+sheetCoords index sheet = do+  let boxSize = sheet.padding + sheet.frameSize+  let framesPerRow = sheet.size.x `div` boxSize.x+  let start = V2 (index `mod` framesPerRow) (index `div` framesPerRow)+  (start * (sheet.frameSize + 1), sheet.frameSize)++data AnimationFrames = RangedFrames Int Int | ManualFrames [Int] deriving (Show)++data AnimationTime = FpsTime Float | TotalTime Float deriving (Show)++data Animation = Animation {dummy :: Bool, time :: AnimationTime, frames :: AnimationFrames, loop :: Bool, spritesheet :: KdlRef Spritesheet} deriving (Component, Show)++noAnimation :: AssetRef Animation+noAnimation = pure $ Animation {dummy = True, time = TotalTime 0, frames = ManualFrames [0], loop = False, spritesheet = noSpritesheet}++nframes :: Animation -> Int+nframes Animation {frames = RangedFrames start end} = end - start + 1+nframes Animation {frames = ManualFrames f} = length f++animFrameIndex :: Int -> AnimationFrames -> Maybe Int+animFrameIndex frame (RangedFrames start end) =+  let f = start + frame+   in if f <= end then Just f else Nothing+animFrameIndex frame (ManualFrames f) = f !? frame++animFrameCoords :: Int -> Animation -> System (Maybe SpriteSlice)+animFrameCoords frame animation = do+  let index = animFrameIndex frame animation.frames+  case index of+    Nothing -> pure Nothing+    Just index -> do+      sheet <- asset $ toRef animation.spritesheet+      case sheet of+        Nothing -> pure Nothing+        Just sheet -> do+          pure $ Just $ uncurry SpriteSlice $ sheetCoords index sheet++qanimFrameCoords :: Int -> Animation -> Query System (Maybe SpriteSlice)+qanimFrameCoords frame animation = do+  let index = animFrameIndex frame animation.frames+  case index of+    Nothing -> pure Nothing+    Just index ->+      Just <$> do+        sheet <- qasset $ kdlToAssetRef animation.spritesheet+        pure $ uncurry SpriteSlice $ sheetCoords index sheet++qanimImage :: Animation -> Query System Entity+qanimImage animation = do+  sheet <- qasset $ kdlToAssetRef animation.spritesheet+  qmaybe =<< qlift (getRefEntity sheet.image)++instance Asset Spritesheet where+  type Saveable Spritesheet = False+  loadAsset = loadKdl "spritesheet"++instance KdlAsset Spritesheet where+  decodeKdl path = KDL.children $ do+    frameSize <- KDL.node "frameSize"+    padding <- KDL.node "padding"+    size <- KDL.node "size"+    image <- KDL.nodeWith "image" $ decodeKdl path++    pure $ Spritesheet {frameSize, padding, size, image}++instance Asset Animation where+  type Saveable Animation = False+  loadAsset = loadKdl "animation"++instance KdlAsset Animation where+  decodeKdl path = KDL.children $ do+    time <- animationTimeDecoder+    frames <- animationFramesDecoder+    loop <- animationLoopDecoder+    spritesheet <- KDL.nodeWith "spritesheet" $ decodeKdl path+    pure $ Animation {dummy = False, time, frames, loop, spritesheet}++animationTimeDecoder :: KDL.NodeListDecoder AnimationTime+animationTimeDecoder = f1 <|> f2+  where+    f1 = FpsTime <$> KDL.argAt "fps"+    f2 = TotalTime <$> KDL.argAt "time"++animationFramesDecoder :: KDL.NodeListDecoder AnimationFrames+animationFramesDecoder = f1 <|> f2+  where+    f1 = do+      KDL.nodeWith "range" $ do+        start <- KDL.arg+        RangedFrames start <$> KDL.arg+    f2 = ManualFrames <$> KDL.argsAt "frames"++animationLoopDecoder :: KDL.NodeListDecoder Bool+animationLoopDecoder = f1 <|> f2+  where+    f1 = KDL.argAt "loop"+    f2 = pure False
+ src/Mischief/Materials.hs view
@@ -0,0 +1,16 @@+module Mischief.Materials+  ( module Mischief.Render.Material.Definition,+    module Mischief.Shader,+    module Mischief.Render.Texture,+    module Mischief.Render.Core,+    module Mischief.Render.Buffer,+    module Mischief.Math,+  )+where++import Mischief.Math (V2 (..), V3 (..), V4 (..))+import Mischief.Render.Buffer (Buffer)+import Mischief.Render.Core (Sampler)+import Mischief.Render.Material.Definition (Clear (..), ExtensionOf, FetchBindings (..), Material (..), NoMaterial, bindings, extension, liftExt)+import Mischief.Render.Texture (Texture)+import Mischief.Shader
+ src/Mischief/Materials/Fullscreen.hs view
@@ -0,0 +1,39 @@+module Mischief.Materials.Fullscreen where++import Mischief.Materials+import Prelude ()++data Bindings f = Bindings deriving (Generic, Bindable)++newtype VertexInput f = VertexInput (BuiltIn f "vertex_index" Uint)+  deriving stock (Generic)+  deriving anyclass (ShaderParam)++data VertexOutput f = VertexOutput+  { pos :: BuiltIn f "position" (Vec 4 Float),+    uv :: Location f 0 (Vec 2 Float)+  }+  deriving (Generic, ShaderParam)++-- | Material for rendering something to the whole screen.+data FullscreenMaterial++instance Material FullscreenMaterial where+  type VI FullscreenMaterial = VertexInput+  type VO FullscreenMaterial = VertexOutput+  type B FullscreenMaterial = Bindings++  vertex :: VertexInput GPU -> Shader FullscreenMaterial (VertexOutput GPU)+  vertex (VertexInput index) = do+    positions <- var $ array @(Vec 2 Float) [vec2 (-1) (-1), vec2 3 (-1), vec2 (-1) 3]+    let pos = positions !! index+    pure+      $ VertexOutput+        { pos = vec4 pos.x pos.y 0 1,+          uv = vec2 (pos.x * 0.5 + 0.5) (1.0 - (pos.y * 0.5 + 0.5))+        }++  fragment :: VertexOutput GPU -> Shader FullscreenMaterial (Vec 4 Float)+  fragment _ = pure $ diag 0++  fetch = FetchBindings (const $ pure ()) (const $ pure ()) (const $ const Bindings)
+ src/Mischief/Materials/Sprite.hs view
@@ -0,0 +1,120 @@+module Mischief.Materials.Sprite where++import Mischief.Materials+import Mischief.Materials.Time (TimeMaterial, getTime)+import Mischief.Render.Camera (CameraMatrices (CameraMatrices), Matrices (..))+import Mischief.Render.Core (DefaultSampler (..))+import Mischief.Render.Image+import Mischief.Render.Sprite.Common+import Prelude ()++data SpriteData f = SpriteData+  { coords :: Field f (Vec 3 Float),+    size :: Field f (Vec 2 Float),+    slice :: Field f (Vec 4 Float),+    flip :: Field f (Vec 2 Int),+    rotation :: Field f (Mat 3 3)+  }+  deriving stock (Generic)+  deriving anyclass (Bufferable)++newtype VertexInput f = VertexInput (BuiltIn f "vertex_index" Uint)+  deriving stock (Generic)+  deriving anyclass (ShaderParam)++data VertexOutput f = VertexOutput+  { pos :: BuiltIn f "position" (Vec 4 Float),+    uv :: Location f 0 (Vec 2 Float)+  }+  deriving (Generic, ShaderParam)++data Bindings f = Bindings+  { matrices :: Uniform f (Matrices f),+    sprite :: Uniform f (SpriteData f),+    texture :: Binding f Texture,+    sampler :: Binding f Sampler+  }+  deriving (Generic, Bindable)++data SpriteMaterial++instance Material SpriteMaterial where+  type VI SpriteMaterial = VertexInput+  type VO SpriteMaterial = VertexOutput+  type B SpriteMaterial = Bindings++  vertex :: VertexInput GPU -> Shader SpriteMaterial (VertexOutput GPU)+  vertex (VertexInput index) = do+    b <- bindings++    positions <- var $ array @(Vec2 Float) [vec2 (-1) (-1), vec2 1 (-1), vec2 1 1, vec2 (-1) (-1), vec2 1 1, vec2 (-1) 1]+    uvs <- var $ array @(Vec2 Float) [vec2 0 1, vec2 1 1, vec2 1 0, vec2 0 1, vec2 1 0, vec2 0 0]++    pos <- var $ (positions !! index) * b.sprite.size * diag 0.5+    pos <- var $ b.sprite.rotation !*^ (pos +: 0)+    pos <- var $ pos + b.sprite.coords+    pos <- var $ b.matrices.projection !*^ (b.matrices.view !*^ (pos +: 1))++    pure+      VertexOutput+        { pos = vec3 pos.x pos.y pos.z +: 1,+          uv = uvs !! index+        }++  fragment :: VertexOutput GPU -> Shader SpriteMaterial (Vec 4 Float)+  fragment VertexOutput {uv} = sampleSprite uv++  fetch =+    FetchBindings+      ( \camera -> do+          (DefaultSampler sampler) <- qres @DefaultSampler+          CameraMatrices matrices <- qget camera [qd|CameraMatrices|]+          pure (matrices, sampler)+      )+      ( \sprite -> do+          (Sprite {image}, buffer) <- qget sprite [qd|Sprite, (Buffer SpriteData)|]+          ImageTextureView texture <- qget image [qd|ImageTextureView|]+          pure (buffer, texture)+      )+      (\(matrices, sampler) (buffer, texture) -> Bindings {matrices, sampler, sprite = buffer, texture})++sampleSprite :: Vec 2 Float -> Shader SpriteMaterial (Vec 4 Float)+sampleSprite uv = do+  b <- bindings+  let uv_flipped :: Vec 2 Float = abs $ cast b.sprite.flip - uv+  let uv = uv_flipped * vec2 b.sprite.slice.z b.sprite.slice.w + b.sprite.slice.xy+  pure $ sample b.texture b.sampler uv++newtype SomeColor f = SomeColor {color :: Field f (Vec 3 Float)}+  deriving stock (Generic)+  deriving anyclass (Bufferable)++newtype CustomBindings f = CustomBindings (Uniform f (SomeColor f))+  deriving stock (Generic)+  deriving anyclass (Bindable)++data CustomMat++instance Material CustomMat where+  type VI CustomMat = VI SpriteMaterial+  type VO CustomMat = VO SpriteMaterial++  type B CustomMat = CustomBindings++  type Extends CustomMat = '[SpriteMaterial, TimeMaterial]++  vertex = liftExt . vertex @SpriteMaterial++  fragment :: VO CustomMat GPU -> Shader CustomMat (Vec 4 Float)+  fragment vo = do+    color <- liftExt $ fragment @SpriteMaterial vo+    time <- liftExt getTime+    (CustomBindings (SomeColor c)) <- bindings+    pure $ color * (c ^* cos time +: 1)++  fetch =+    FetchBindings+      { camera = const $ pure (),+        mesh = \sprite -> qget sprite [qd|(Buffer SomeColor)|],+        result = const CustomBindings+      }
+ src/Mischief/Materials/Time.hs view
@@ -0,0 +1,36 @@+module Mischief.Materials.Time where++import Mischief.Materials+import Mischief.Render.Material.Definition+import Prelude ()+import Prelude qualified++data TimeMaterial++newtype TimeData f = TimeData (Field f Float)+  deriving stock (Generic)+  deriving anyclass (Bufferable)++newtype Bindings f = Bindings {x :: Uniform f (TimeData f)}+  deriving stock (Generic)+  deriving anyclass (Bindable)++instance Material TimeMaterial where+  type VI TimeMaterial = DefaultVI+  type VO TimeMaterial = DefaultVO++  type IsPhantom TimeMaterial = Prelude.True++  type B TimeMaterial = Bindings++  fetch =+    FetchBindings+      { camera = \_ -> qres @(Buffer TimeData),+        mesh = \_ -> pure (),+        result = \t _ -> Bindings t+      }++getTime :: Shader TimeMaterial Float+getTime = do+  Bindings (TimeData t) <- bindings+  pure t
+ src/Mischief/Render.hs view
@@ -0,0 +1,102 @@+{- HLINT ignore "Use newtype instead of data" -}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Render+  ( -- * Mischief Render+    -- $intro++    -- * Dependencies+    -- $deps++    -- * The Rendering Book+    -- $book+    module Mischief.SDL.Window,+    module Mischief.Render.Plugin,+    module Mischief.Render.Sprite.Common,+    module Mischief.Render.Camera,+    module Mischief.Render.Material,+    module Mischief.Render.Core,+    module Mischief.Render.Buffer,+    module Mischief.Materials,+    module Mischief.Render.Layers,+    module Mischief.Render.Material.Definition,+  )+where++import Mischief.Materials (CPU, GPU)+import Mischief.Render.Buffer (Buffer, createBuffer, maintainBuffer, uploadBuffer)+import Mischief.Render.Camera (Camera (..), OutputTo (..), cameraSwapView, cameraView)+import Mischief.Render.Core (RenderAdapter, RenderDevice, RenderFirst, RenderLast, RenderPostprocess, RenderPrepare, RenderQueue, RenderTransparent, RenderUpdate)+import Mischief.Render.Layers+  ( RenderLayers,+    layer0,+    layer1,+    layer10,+    layer11,+    layer12,+    layer13,+    layer14,+    layer15,+    layer16,+    layer17,+    layer18,+    layer19,+    layer2,+    layer20,+    layer21,+    layer22,+    layer23,+    layer24,+    layer25,+    layer26,+    layer27,+    layer28,+    layer29,+    layer3,+    layer30,+    layer31,+    layer4,+    layer5,+    layer6,+    layer7,+    layer8,+    layer9,+  )+import Mischief.Render.Material (WithMaterial (..), renderMaterial, renderSortedMaterial)+import Mischief.Render.Material.Definition (Clear (..), RenderOptions (..))+import Mischief.Render.Plugin (RenderPlugin)+import Mischief.Render.Sprite.Common (Anchor (..), Sprite (..), SpriteFlip (..), SpriteSlice (..))+import Mischief.SDL.Window++-- $intro+-- This is the official rendering library for the Mischief game engine. It has tools for rendering, shading, and animating meshes and other+-- objects. It uses SDL and WGPU, being compatible with most major rendering backends (Vulkan, Metal, DirectX, WebGPU, etc.).+--+-- The renderer is highly customizable and extensible. Custom, strongly-typed shaders are written directly in Haskell.+-- Materials are easy to schedule, extend, and modify.++-- $deps+-- * [mischief-ecs]("Mischief.ECS")+-- * [mischief-sdl]("Mischief.SDL")+-- * [mischief-assets]("Mischief.Assets")+-- * [mischief-math]("Mischief.Math")+--+-- You will need to manually install the following libraries (click for install guide):+--+-- * [SDL]("Mischief.SDL")+-- * [WGPU]("Mischief.WGPU")++-- $book+--+-- * 1. Introduction+--+--     * 1.1. [Starting Out]("Mischief.Render.Tutorial.Start.Start")+--     * 1.2. [Your First Animation]("Mischief.Render.Tutorial.Start.Animation")+--     * 1.3. [Your First Shader]("Mischief.Render.Tutorial.Start.Shader")+--+-- * 2. Guides+--+--     * 2.1. [Basics]("Mischief.Render.Tutorial.Basics")+--     * 2.2. [Shaders]("Mischief.Render.Tutorial.Shaders")+--     * 2.3. [Materials]("Mischief.Render.Tutorial.Materials")+-- a
+ src/Mischief/Render/Bind.hs view
@@ -0,0 +1,40 @@+module Mischief.Render.Bind where++import Control.Monad.IO.Class+import Data.Primitive.Ptr+import Foreign.C.ConstPtr+import Mischief.ECS+import Mischief.Render.Core (Sampler (..))+import Mischief.Render.Texture+import Mischief.Shader.Internal.Bindings+import Mischief.WGPU+import Mischief.WGPU.Types.General++-- bindTexture :: Texture -> System (Binding index Texture)+-- bindTexture (Texture {texture}) = do+--   textureView <- liftIO $ wgpuTextureCreateView texture (ConstPtr nullPtr)+--   pure $+--     BindEntry $+--       WGPUBindGroupEntry+--         { binding = 0,+--           textureView = textureView,+--           size = 0,+--           offset = 0,+--           sampler = nullPtr,+--           buffer = nullPtr,+--           nextInChain = nullPtr+--         }++-- bindSampler :: Sampler -> System (Binding index Sampler)+-- bindSampler (Sampler sampler) =+--   pure $+--     BindEntry $+--       WGPUBindGroupEntry+--         { binding = 1,+--           textureView = nullPtr,+--           size = 0,+--           offset = 0,+--           sampler = sampler,+--           buffer = nullPtr,+--           nextInChain = nullPtr+--         }
+ src/Mischief/Render/Buffer.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Render.Buffer where++import Control.Monad.IO.Class+import Data.Data (Typeable)+import Foreign (Ptr, allocaBytes, castPtr, nullPtr, with, (.|.))+import Foreign.C.ConstPtr (ConstPtr (..))+import Language.Haskell.TH (Extension (AllowAmbiguousTypes))+import Mischief.ECS+import Mischief.Render.Core+import Mischief.Shader.Internal.Buffers+import Mischief.Shader.Internal.State (CPU)+import Mischief.WGPU (wgpuDeviceCreateBuffer, wgpuQueueWriteBuffer, withWGPUString)+import Mischief.WGPU.Opaque (WGPUBuffer)+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++data Buffer a = Buffer {buffer :: Ptr WGPUBuffer, desc :: BufferDescriptor} deriving (Component)++data BufferDescriptor = BufferDescriptor+  { label :: String,+    size :: Int,+    usages :: [BufferUsage],+    mappedAtCreation :: Bool+  }++data BufferUsage+  = BufferUsageNone+  | BufferUsageMapRead+  | BufferUsageMapWrite+  | BufferUsageCopySrc+  | BufferUsageCopyDst+  | BufferUsageIndex+  | BufferUsageVertex+  | BufferUsageUniform+  | BufferUsageStorage+  | BufferUsageIndirect+  | BufferUsageQueryResolve++usageBits :: BufferUsage -> WGPUBufferUsage+usageBits = \case+  BufferUsageNone -> wGPUBufferUsage_None+  BufferUsageMapRead -> wGPUBufferUsage_MapRead+  BufferUsageMapWrite -> wGPUBufferUsage_MapWrite+  BufferUsageCopySrc -> wGPUBufferUsage_CopySrc+  BufferUsageCopyDst -> wGPUBufferUsage_CopyDst+  BufferUsageIndex -> wGPUBufferUsage_Index+  BufferUsageVertex -> wGPUBufferUsage_Vertex+  BufferUsageUniform -> wGPUBufferUsage_Uniform+  BufferUsageStorage -> wGPUBufferUsage_Storage+  BufferUsageIndirect -> wGPUBufferUsage_Indirect+  BufferUsageQueryResolve -> wGPUBufferUsage_QueryResolve++processUsages :: [BufferUsage] -> WGPUBufferUsage+processUsages = foldr ((.|.) . usageBits) (WGPUBufferUsage (WGPUFlags 0))++createBuffer' :: RenderDevice -> BufferDescriptor -> System (Buffer a)+createBuffer' (RenderDevice device) descriptor = liftIO $ do+  let BufferDescriptor {label, size, usages, mappedAtCreation} = descriptor++  withWGPUString label $ \label -> do+    let desc =+          WGPUBufferDescriptor+            { nextInChain = nullPtr,+              label,+              usage = processUsages usages,+              size = fromIntegral size,+              mappedAtCreation = if mappedAtCreation then wgpuTrue else wgpuFalse+            }++    buffer <- with desc $ wgpuDeviceCreateBuffer device . ConstPtr+    pure $ Buffer {buffer, desc = descriptor}++createBuffer :: forall a. (Bufferable a) => RenderDevice -> System (Buffer a)+createBuffer device = do+  createBuffer'+    device+    BufferDescriptor+      { label = "buffer",+        size = getSize @a,+        usages = [BufferUsageCopyDst, BufferUsageUniform],+        mappedAtCreation = False+      }++uploadBuffer :: forall a. (Bufferable a) => RenderQueue -> Buffer a -> a CPU -> System ()+uploadBuffer (RenderQueue queue) Buffer {buffer, desc = BufferDescriptor {size}} a = liftIO $ do+  allocaBytes size $ \ptr -> do+    _ <- putBytes a ptr+    wgpuQueueWriteBuffer queue buffer 0 (ConstPtr $ castPtr ptr) (fromIntegral size)++maintainBuffer :: forall a. (Typeable a, Component (a CPU), Bufferable a) => System ()+maintainBuffer = query_ $ do+  device <- qres @RenderDevice+  queue <- qres @RenderQueue++  (entity, buffer, dt) <- [q|Entity, Maybe (Buffer a), (a CPU) / Changed (a CPU) || Without (Buffer a)|]++  buffer <- case buffer of+    Just x -> pure x+    Nothing -> qlift $ do+      buffer <- createBuffer @a device+      insert buffer entity+      pure buffer++  qlift $ uploadBuffer queue buffer dt
+ src/Mischief/Render/Camera.hs view
@@ -0,0 +1,182 @@+module Mischief.Render.Camera where++import Codec.Picture+import Control.Monad+import Control.Monad.IO.Class+import Data.Bits+import Data.Default+import Data.Foldable+import Data.Maybe (fromMaybe)+import Data.Primitive.Ptr (nullPtr)+import Data.Vector.Storable qualified as VS+import Data.Word+import Foreign (with)+import Foreign.C.ConstPtr+import GHC.Generics (Generic)+import Linear (V3 (V3), V4 (V4), (!*!))+import Mischief.ECS+import Mischief.ECS.Events+import Mischief.ECS.Systems qualified as S+import Mischief.Math.Transform+import Mischief.Render.Buffer+import Mischief.Render.Core+import Mischief.Render.Layers (RenderLayers)+import Mischief.Render.Texture+import Mischief.Render.Texture (createTexture)+import Mischief.Render.Texture qualified as Texture+import Mischief.SDL.Window+import Mischief.Shader (Bufferable, Field)+import Mischief.Shader.Internal.State (CPU)+import Mischief.Shader.Types qualified as ST+import Mischief.WGPU (wgpuDeviceCreateTexture, wgpuTextureRelease, withWGPUString)+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++data Camera = Camera++instance Component Camera where+  required = require @(Transform, RenderLayers)++-- | Add this as a relationship between a camera and a window to have the+-- camera's output texture be rendered to that window.+--+-- Exclusive.+data OutputTo = OutputTo++instance Component OutputTo where+  type IsExclusiveRel OutputTo = True++newtype CameraTexture = CameraTexture SwappableTexture++instance Component CameraTexture where+  onRemove =+    [ hook $ \(HookContext entity) -> do+        Just (CameraTexture (SwappableTexture {currentTexture, otherTexture})) <- single [q|entity. CameraTexture|]+        liftIO $ wgpuTextureRelease currentTexture+        liftIO $ wgpuTextureRelease otherTexture+    ]++newtype CameraMatrices = CameraMatrices (Buffer Matrices) deriving anyclass (Component)++data CameraPlugin++instance Plugin CameraPlugin where+  init = do+    void $ spawn $ Observer onAddCameraOutputTo+    void $ spawn $ Observer onUpdateWindowSize++    systems updateCameraMatrices+      & schedule @Update++updateCameraMatrices :: System ()+updateCameraMatrices = do+  device <- res @RenderDevice+  queue <- res @RenderQueue+  for_ ((,) <$> device <*> queue) go+  where+    go :: (RenderDevice, RenderQueue) -> System ()+    go (device, queue) = do+      cameras <- query [q|Entity, Maybe CameraMatrices, Transform, OutputTo -> (WindowSize) / With Camera|]+      for_ cameras $ \(entity, buffer, transform, From _ (WindowSize w h)) -> do+        buffer <- case buffer of+          Just (CameraMatrices b) -> pure b+          Nothing -> do+            buffer <- createBuffer @Matrices device+            insert (CameraMatrices buffer) entity+            pure buffer++        uploadBuffer queue buffer (getCameraProjection w h transform)++onAddCameraOutputTo :: OnAddRel OutputTo -> System ()+onAddCameraOutputTo (OnAddRel entity target) = updateCameraTexture entity target++onUpdateWindowSize :: OnSet WindowSize -> System ()+onUpdateWindowSize (OnSet window) = do+  cameras <- query [q|Entity / With OutputTo -> window|]+  for_ cameras $ \camera -> updateCameraTexture camera window++-- | Creates a new CameraTexture component that fits the targeted window.+updateCameraTexture :: Entity -> Entity -> System ()+updateCameraTexture camera window = do+  Just device <- res @RenderDevice+  window <- single [q|window. WindowSize|]+  case window of+    Nothing -> warn "Camera output window not found."+    Just (WindowSize width height) -> do+      texture <- liftIO $ createSwappableTexture device (textureDescriptor {Texture.width, height})+      insert (CameraTexture texture) camera++newTextureDescriptor :: Int -> Int -> WGPUStringView -> WGPUTextureDescriptor+newTextureDescriptor w h label =+  WGPUTextureDescriptor+    { size = WGPUExtent3D (fromIntegral w) (fromIntegral h) 1,+      label,+      mipLevelCount = 1,+      sampleCount = 1,+      dimension = wGPUTextureDimension_2D,+      format = wGPUTextureFormat_RGBA8UnormSrgb,+      usage = wGPUTextureUsage_TextureBinding .|. wGPUTextureUsage_CopyDst,+      nextInChain = nullPtr,+      viewFormatCount = 0,+      viewFormats = ConstPtr nullPtr+    }++data Matrices f = Matrices+  { projection :: Field f (ST.Mat 4 4),+    view :: Field f (ST.Mat 4 4)+  }+  deriving stock (Generic)+  deriving anyclass (Bufferable)++getCameraProjection :: Int -> Int -> Transform -> Matrices CPU+getCameraProjection w h Transform {translation = pos} = do+  let l = pos.x - (fromIntegral w / 2)+  let r = pos.x + (fromIntegral w / 2)+  let t = pos.y + (fromIntegral h / 2)+  let b = pos.y - (fromIntegral h / 2)+  let n = 0+  let f = 100++  let forward = V3 0 0 1+  let right = V3 1 0 0+  let up = V3 0 1 0++  let rotation =+        V4+          (V4 right.x right.y right.z 0)+          (V4 up.x up.y up.z 0)+          (V4 forward.x forward.y forward.z 0)+          (V4 0 0 0 1)++  let translation' =+        V4+          (V4 1 0 0 0)+          (V4 0 1 0 0)+          (V4 0 0 1 0)+          (V4 (-pos.x) (-pos.y) (-pos.z) 1)++  let translation :: V4 (V4 Float) = rotation !*! translation'+  -- let V4 v1 v2 v3 v4 = translation++  Matrices+    -- projection matrix+    ( V4+        (V4 (2 / (r - l)) 0 0 (-((r + l) / (r - l))))+        (V4 0 (2 / (t - b)) 0 (-((t + b) / (t - b))))+        (V4 0 0 (-(2 / (f - n))) (-((f + n) / (f - n))))+        (V4 0 0 0 1)+    )+    -- view matrix+    translation++cameraView :: Entity -> Query System TextureView+cameraView camera = do+  CameraTexture (SwappableTexture {currentTexture = texture, desc}) <- qget camera [qd|CameraTexture|]+  qlift $ createView $ Texture texture desc++cameraSwapView :: Entity -> Query System TextureView+cameraSwapView camera = do+  CameraTexture (SwappableTexture {currentTexture = texture, desc, otherTexture}) <- qget camera [qd|CameraTexture|]+  qlift $ do+    insert (CameraTexture $ SwappableTexture {currentTexture = otherTexture, otherTexture = texture, desc}) camera+    createView $ Texture texture desc
+ src/Mischief/Render/Core.hs view
@@ -0,0 +1,265 @@+module Mischief.Render.Core where++import Control.Monad+import Control.Monad.IO.Class+import Data.ByteString qualified as BS+import Data.Default (Default)+import Data.Maybe (isNothing)+import Data.Primitive (Ptr)+import Data.Primitive.Ptr (nullPtr)+import Foreign (Storable (peek, poke), alloca, castPtr, free, malloc, with)+import Foreign.C (peekCString)+import Foreign.C.ConstPtr+import Mischief.ECS+import Mischief.ECS.Events+import Mischief.ECS.Hooks+import Mischief.ECS.Systems qualified as Systems+import Mischief.Render.TextureFormat+import Mischief.SDL (SDLPlugin (..), SDLWindow (SDLWindow))+import Mischief.SDL.Window+import Mischief.WGPU+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General+import SDL3.Sys qualified as SDL3+import SDL3.Sys.Bindgen.Metal.FunPtr qualified as SDL3++type CameraEntity = Entity++type MeshEntity = Entity++newtype RenderInstance = RenderInstance (Ptr WGPUInstance) deriving anyclass (Component)++newtype RenderSurface = RenderSurface (Ptr WGPUSurface)++newtype DefaultSampler = DefaultSampler Sampler deriving anyclass (Component)++instance Component RenderSurface where+  onRemove =+    [ hook $ \(HookContext entity) -> do+        Just (RenderSurface surface) <- single [q|entity. RenderSurface|]+        liftIO $ wgpuSurfaceRelease surface+    ]++newtype RenderDevice = RenderDevice (Ptr WGPUDevice)++instance Component RenderDevice where+  onRemove =+    [ hook $ \(HookContext entity) -> do+        Just (RenderDevice device) <- single [q|entity. RenderDevice|]+        liftIO $ wgpuDeviceRelease device+    ]++newtype RenderAdapter = RenderAdapter (Ptr WGPUAdapter)++instance Component RenderAdapter where+  onRemove =+    [ hook $ \(HookContext entity) -> do+        Just (RenderAdapter adapter) <- single [q|entity. RenderAdapter|]+        liftIO $ wgpuAdapterRelease adapter+    ]++newtype RenderQueue = RenderQueue (Ptr WGPUQueue)++instance Component RenderQueue where+  onRemove =+    [ hook $ \(HookContext entity) -> do+        Just (RenderQueue queue) <- single [q|entity. RenderQueue|]+        liftIO $ wgpuQueueRelease queue+    ]++newtype WindowFormat = WindowFormat WGPUTextureFormat deriving anyclass (Component)++newtype WindowAlphaMode = WindowAlphaMode WGPUCompositeAlphaMode deriving anyclass (Component)++-- | Creates a WGPU Surface, Adapter, and Device for each new window. Inserts them as components.+onAddWindow :: OnAdd SDLWindow -> System ()+onAddWindow (OnAdd entity) = do+  Just (SDLWindow window, WindowSize w h) <- single [q|entity. SDLWindow, WindowSize|]++  windowProps <- liftIO $ SDL3.getWindowProperties window+  driver <- liftIO (peekCString . unConstPtr =<< SDL3.getCurrentVideoDriver)++  Just (RenderInstance wgpuInstance) <- res @RenderInstance++  surface <- liftIO $ getSurfaceDescriptor wgpuInstance driver windowProps window++  when (surface == nullPtr) $ error "Couldn't create WGPU surface."++  tryAdapter <- res @RenderAdapter+  (adapter, device, _) <- case tryAdapter of+    Just (RenderAdapter adapter) -> do+      Just (RenderDevice device) <- res @RenderDevice+      Just (RenderQueue queue) <- res @RenderQueue+      pure (adapter, device, queue)+    Nothing -> do+      adapter <- liftIO $ wgpuInstanceRequestAdapter wgpuInstance surface+      device <- liftIO $ wgpuAdapterRequestDevice adapter+      queue <- liftIO $ wgpuDeviceGetQueue device++      insertRes (RenderAdapter adapter)+      insertRes (RenderDevice device)+      insertRes (RenderQueue queue)+      pure (adapter, device, queue)++  surfaceCapabilities <- liftIO $ malloc @WGPUSurfaceCapabilities+  liftIO $ wgpuSurfaceGetCapabilities surface adapter surfaceCapabilities++  cap <- liftIO $ peek surfaceCapabilities+  liftIO $ free surfaceCapabilities+  let (ConstPtr formats) = cap.formats+  let (ConstPtr alphaModes) = cap.alphaModes+  format <- liftIO $ peek formats+  alphaMode <- liftIO $ peek alphaModes++  let config =+        newWGPUSurfaceConfiguration+          { device,+            usage = wGPUTextureUsage_RenderAttachment,+            format,+            presentMode = wGPUPresentMode_Fifo,+            alphaMode,+            width = fromIntegral w,+            height = fromIntegral h+          }++  liftIO $ with config $ \config -> do+    wgpuSurfaceConfigure surface (ConstPtr config)++  insert (RenderSurface surface, WindowFormat format, WindowAlphaMode alphaMode) entity++  sampler <- newSampler (RenderDevice device)+  insertRes $ DefaultSampler sampler++onSetWindowSize :: OnSet WindowSize -> System ()+onSetWindowSize (OnSet window) = query_ $ do+  (WindowSize w h, RenderSurface surface, WindowAlphaMode alphaMode, WindowFormat format) <- [q|window. WindowSize, RenderSurface, WindowAlphaMode, WindowFormat|]+  (RenderDevice device) <- qres++  let config =+        newWGPUSurfaceConfiguration+          { device,+            usage = wGPUTextureUsage_RenderAttachment,+            format,+            presentMode = wGPUPresentMode_Fifo,+            alphaMode,+            width = fromIntegral w,+            height = fromIntegral h+          }++  qlift $ do+    liftIO $ with config $ \config -> do+      wgpuSurfaceConfigure surface (ConstPtr config)++-- | Maps a SDL driver name and window to the correct surface texture for WGPU.+--+-- TODO: implement the rest of the drivers.+getSurfaceDescriptor :: Ptr WGPUInstance -> String -> SDL3.SDL_PropertiesID -> Ptr SDL3.SDL_Window -> IO (Ptr WGPUSurface)+getSurfaceDescriptor inst "x11" props _ = do+  display <- BS.useAsCString SDL3.sDL_PROP_WINDOW_X11_DISPLAY_POINTER $ \b -> SDL3.getPointerProperty props (ConstPtr b) nullPtr+  window <- BS.useAsCString SDL3.sDL_PROP_WINDOW_X11_WINDOW_NUMBER $ \b -> SDL3.getNumberProperty props (ConstPtr b) (-1)++  when (display == nullPtr || window == -1) $ error "Can't obtain x11 window."++  let chain = WGPUChainedStruct {next = nullPtr, sType = wGPUSType_SurfaceSourceXlibWindow}+  let xlib = WGPUSurfaceSourceXlibWindow {chain, display, window}++  with xlib $ \xlib ->+    with+      ( WGPUSurfaceDescriptor+          { nextInChain = castPtr xlib,+            label = WGPUStringView {_data = ConstPtr nullPtr, length = 0}+          }+      )+      $ wgpuInstanceCreateSurface inst . ConstPtr+getSurfaceDescriptor inst "windows" props _ = do+  hwnd <- BS.useAsCString SDL3.sDL_PROP_WINDOW_WIN32_HWND_POINTER $ \b -> SDL3.getPointerProperty props (ConstPtr b) nullPtr+  hinstance <- BS.useAsCString SDL3.sDL_PROP_WINDOW_WIN32_INSTANCE_POINTER $ \b -> SDL3.getPointerProperty props (ConstPtr b) nullPtr++  let chain = WGPUChainedStruct {next = nullPtr, sType = wGPUSType_SurfaceSourceWindowsHWND}+  let win = WGPUSurfaceSourceWindowsHWND {chain, hinstance, hwnd}++  with win $ \win ->+    with+      ( WGPUSurfaceDescriptor+          { nextInChain = castPtr win,+            label = WGPUStringView {_data = ConstPtr nullPtr, length = 0}+          }+      )+      $ wgpuInstanceCreateSurface inst . ConstPtr+getSurfaceDescriptor inst "cocoa" _ window = do+  x <- SDL3.metalCreateView window+  layer <- SDL3.metalGetLayer x++  when (layer == nullPtr) $ error "Couldn't obtain metal layer!"++  let chain = WGPUChainedStruct {next = nullPtr, sType = wGPUSType_SurfaceSourceMetalLayer}+  let cocoa = WGPUSurfaceSourceMetalLayer {chain, layer}++  with cocoa $ \cocoa ->+    with+      ( WGPUSurfaceDescriptor+          { nextInChain = castPtr cocoa,+            label = WGPUStringView {_data = ConstPtr nullPtr, length = 0}+          }+      )+      $ wgpuInstanceCreateSurface inst . ConstPtr+getSurfaceDescriptor _ s _ _ = error $ "Incompatible driver: " ++ s++newtype BindLayout = BindLayout (Ptr WGPUBindGroupLayout)++newtype RenderPipeline = RenderPipeline (Ptr WGPURenderPipeline)++-- newtype TextureFormat = TextureFormat WGPUTextureFormat++newtype Sampler = Sampler (Ptr WGPUSampler)++getRenderingResources :: System (Maybe (RenderAdapter, RenderDevice, RenderQueue))+getRenderingResources = do+  adapter <- res @RenderAdapter+  device <- res @RenderDevice+  queue <- res @RenderQueue+  pure $ (,,) <$> adapter <*> device <*> queue++data RenderFirst = RenderFirst deriving (Schedule)++data RenderPrepare = RenderPrepare deriving (Schedule)++data RenderUpdate = RenderUpdate deriving (Schedule)++data RenderTransparent = RenderTransparent deriving (Schedule)++data RenderPostprocess = RenderPostprocess deriving (Schedule)++data RenderLast = RenderLast deriving (Schedule)++getFormat :: RenderSurface -> RenderAdapter -> System TextureFormat+getFormat (RenderSurface surface) (RenderAdapter adapter) = liftIO $ do+  surfaceCapabilities <- malloc @WGPUSurfaceCapabilities+  wgpuSurfaceGetCapabilities surface adapter surfaceCapabilities++  cap <- peek surfaceCapabilities+  free surfaceCapabilities+  let (ConstPtr formats) = cap.formats+  format <- peek formats++  pure $ fromWGPUFormat format++newSampler :: RenderDevice -> System Sampler+newSampler (RenderDevice device) = liftIO $ do+  let samplerDesc =+        WGPUSamplerDescriptor+          { addressModeU = wGPUAddressMode_ClampToEdge,+            addressModeV = wGPUAddressMode_ClampToEdge,+            addressModeW = wGPUAddressMode_ClampToEdge,+            magFilter = wGPUFilterMode_Linear,+            minFilter = wGPUFilterMode_Linear,+            mipmapFilter = wGPUMipmapFilterMode_Nearest,+            nextInChain = nullPtr,+            label = WGPUStringView (ConstPtr nullPtr) 0,+            lodMinClamp = 0,+            lodMaxClamp = 32,+            compare = wGPUCompareFunction_Undefined,+            maxAnisotropy = 1+          }+  Sampler <$> with samplerDesc (wgpuDeviceCreateSampler device . ConstPtr)
+ src/Mischief/Render/Image.hs view
@@ -0,0 +1,64 @@+module Mischief.Render.Image where++import Codec.Picture qualified as P+import Control.Monad+import Data.Foldable+import Data.Primitive.Ptr+import Foreign.C.ConstPtr+import Mischief.Assets+import Mischief.Assets.Image+import Mischief.ECS+import Mischief.ECS.Observer+import Mischief.ECS.Systems qualified as S+import Mischief.Render.Core+import Mischief.Render.Texture+import Mischief.WGPU+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++newtype ImageTexture = ImageTexture Texture deriving anyclass (Component)++newtype ImageTextureView = ImageTextureView TextureView deriving anyclass (Component)++data ImageUploadingPlugin++data QueueUpload = QueueUpload deriving (Component)++instance Plugin ImageUploadingPlugin where+  init = do+    systems uploadImages+      & schedule @Update+    enableImageUploadOnLoad++uploadImages :: System ()+uploadImages = do+  images <- query [q|Entity, Image / With QueueUpload|]+  for_ images $ \(e, _) -> remove (C @QueueUpload) e++  device <- res @RenderDevice+  queue <- res @RenderQueue++  for_ ((,) <$> device <*> queue) $ \(device, queue) -> do+    for_ images $ \(entity, image) -> do+      runAfter+        ( do+            tex <- createTextureForImage device image+            uploadImage queue image tex+            view <- TextureView <$> wgpuTextureCreateView tex.texture (ConstPtr nullPtr)++            pure (tex, view)+        )+        ( \(tex, view) -> do+            insert (ImageTexture tex, ImageTextureView view) entity+        )++queueUploadOnLoad :: OnLoad Image -> System ()+queueUploadOnLoad (OnLoad e) = insert QueueUpload e++data ImageObserver = ImageObserver deriving (Component)++enableImageUploadOnLoad :: System ()+enableImageUploadOnLoad = void $ spawn (Observer queueUploadOnLoad, ImageObserver)++disableImageUploadOnLoad :: System ()+disableImageUploadOnLoad = single [q|Entity / With ImageObserver|] >>= despawn . unwrap
+ src/Mischief/Render/Layers.hs view
@@ -0,0 +1,126 @@+module Mischief.Render.Layers where++import Data.Binary (Word32)+import Data.Bits (Bits ((.&.)), (.|.))+import Mischief.ECS++newtype RenderLayers = RenderLayers Word32+  deriving anyclass (Component)+  deriving newtype (Eq, Show, Bits)++new :: Word32 -> RenderLayers+new = RenderLayers++instance Semigroup RenderLayers where+  (<>) = union++union :: RenderLayers -> RenderLayers -> RenderLayers+union (RenderLayers a) (RenderLayers b) = RenderLayers $ a .|. b++intersection :: RenderLayers -> RenderLayers -> RenderLayers+intersection (RenderLayers a) (RenderLayers b) = RenderLayers $ a .&. b++intersects :: RenderLayers -> RenderLayers -> Bool+intersects a b = intersection a b /= noLayer++instance Default RenderLayers where+  def = layer0++noLayer :: RenderLayers+noLayer = RenderLayers 0++layer0 :: RenderLayers+layer0 = RenderLayers 1++layer1 :: RenderLayers+layer1 = RenderLayers 2++layer2 :: RenderLayers+layer2 = RenderLayers 4++layer3 :: RenderLayers+layer3 = RenderLayers 8++layer4 :: RenderLayers+layer4 = RenderLayers 16++layer5 :: RenderLayers+layer5 = RenderLayers 32++layer6 :: RenderLayers+layer6 = RenderLayers 64++layer7 :: RenderLayers+layer7 = RenderLayers 128++layer8 :: RenderLayers+layer8 = RenderLayers 256++layer9 :: RenderLayers+layer9 = RenderLayers 512++layer10 :: RenderLayers+layer10 = RenderLayers 1024++layer11 :: RenderLayers+layer11 = RenderLayers 2048++layer12 :: RenderLayers+layer12 = RenderLayers 4096++layer13 :: RenderLayers+layer13 = RenderLayers 8192++layer14 :: RenderLayers+layer14 = RenderLayers 16384++layer15 :: RenderLayers+layer15 = RenderLayers 32768++layer16 :: RenderLayers+layer16 = RenderLayers 65536++layer17 :: RenderLayers+layer17 = RenderLayers 131072++layer18 :: RenderLayers+layer18 = RenderLayers 262144++layer19 :: RenderLayers+layer19 = RenderLayers 524288++layer20 :: RenderLayers+layer20 = RenderLayers 1048576++layer21 :: RenderLayers+layer21 = RenderLayers 2097152++layer22 :: RenderLayers+layer22 = RenderLayers 4194304++layer23 :: RenderLayers+layer23 = RenderLayers 8388608++layer24 :: RenderLayers+layer24 = RenderLayers 16777216++layer25 :: RenderLayers+layer25 = RenderLayers 33554432++layer26 :: RenderLayers+layer26 = RenderLayers 67108864++layer27 :: RenderLayers+layer27 = RenderLayers 134217728++layer28 :: RenderLayers+layer28 = RenderLayers 268435456++layer29 :: RenderLayers+layer29 = RenderLayers 536870912++layer30 :: RenderLayers+layer30 = RenderLayers 1073741824++layer31 :: RenderLayers+layer31 = RenderLayers 2147483648
+ src/Mischief/Render/Material.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- {-# LANGUAGE GADTSyntax #-}+-- {-# LANGUAGE RequiredTypeArguments #-}++module Mischief.Render.Material+  ( WithMaterial (..),+    renderMaterial,+    renderSortedMaterial,+  )+where++import Control.Monad (unless, when)+import Data.Data+import Data.List (sort, sortBy)+import Data.Set qualified as Set+import Data.Traversable+import GHC.TypeLits+import Mischief.ECS+import Mischief.Render.Camera (Camera, CameraTexture (CameraTexture))+import Mischief.Render.Core+import Mischief.Render.Layers (RenderLayers)+import Mischief.Render.Layers qualified as Layers+import Mischief.Render.Material.Definition (Clear, DrawCommand (Draw), Extension (collectExtBindings), FetchBindings (..), Material (IsPhantom, fetch), MaterialType (..), RenderOptions (..), render)+import Mischief.Render.Material.Pipeline (qgetPipeline)+import Mischief.Render.Texture+import Mischief.Shader.Internal.Bindings (ErasedBinding (..), ErasedBindingValue (..))+import Unsafe.Coerce (unsafeCoerce)++-- schedule @RenderLast (systems renderEntities)++data WithMaterial m = WithMaterial deriving (Component)++-- spawn' :: forall m. (Material m) => System Entity+-- spawn' = case eqT @(IsPhantom m) @True of+--   Nothing -> Mischief.ECS.spawn (MaterialType $ Proxy @m)+--   Just _ -> Mischief.ECS.spawn (MaterialType $ Proxy @m, PhantomMaterial)++-- retrieve :: forall m. (Material m) => System Entity+-- retrieve = do+--   e <- queryOne [q|Entity / With (MaterialMarker m)|]+--   case e of+--     Just e -> pure e+--     Nothing -> spawn' @m++-- renderEntities :: System ()+-- renderEntities = query_ $ do+--   camera <- [q|Entity / With Camera|]+--   (MaterialType (_ :: Proxy m), e) <- [q|MaterialType, Entity / Without PhantomMaterial|]+--   qrenderMaterial @m camera++renderMaterial :: forall m. (Material m) => RenderOptions -> System ()+renderMaterial opts = query_ $ do+  (camera, layers) <- [q|Entity, RenderLayers / With Camera|]+  qrenderMaterial @m camera layers opts++qrenderMaterial :: forall m. (Material m) => CameraEntity -> RenderLayers -> RenderOptions -> Query System ()+qrenderMaterial camera layers opts = do+  device <- qres+  queue <- qres+  let ext = Set.toList $ collectExtBindings @'[m]+  let fs = eraseFetches ext+  cams <- qfetchCam camera fs++  commands <- qcollect $ do+    (sprite, layers') <- [q|(Entity, RenderLayers) / With (WithMaterial m)|]+    unless (Layers.intersects layers layers') qstop+    b <- qfetchBindings cams sprite+    pure $ Draw b opts.nvertices++  CameraTexture texture <- qget camera [qd|CameraTexture|]+  pipeline <- qgetPipeline @m texture.desc.format+  qlift $ render @m device queue pipeline opts (Texture texture.currentTexture texture.desc) (map (.comp) commands)++renderSortedMaterial :: forall m a. (Material m, Ord a) => RenderOptions -> (MeshEntity -> Query System a) -> System ()+renderSortedMaterial opts f = query_ $ do+  (camera, layers) <- [q|(Entity, RenderLayers) / With Camera|]+  qrenderSortedMaterial @m f camera layers opts++qrenderSortedMaterial :: forall m a. (Material m, Ord a) => (MeshEntity -> Query System a) -> CameraEntity -> RenderLayers -> RenderOptions -> Query System ()+qrenderSortedMaterial f camera layers opts = do+  device <- qres+  queue <- qres+  let ext = Set.toList $ collectExtBindings @'[m]+  let fs = eraseFetches ext+  cams <- qfetchCam camera fs++  commands <- qcollect $ do+    sprites <- qcollect $ do+      (entity, layers') <- [q|(Entity, RenderLayers) / With (WithMaterial m)|]+      unless (Layers.intersects layers layers') qstop+      qpure entity & qmap (const entity)++    sprite <- fst <$> (qentity . qiter . sortBy (\(From _ a) (From _ b) -> compare a b) =<< mapM (\(From _ e) -> From e <$> f e) sprites)++    b <- qfetchBindings cams sprite+    pure $ Draw b opts.nvertices++  CameraTexture texture <- qget camera [qd|CameraTexture|]+  pipeline <- qgetPipeline @m texture.desc.format+  qlift $ render @m device queue pipeline opts (Texture texture.currentTexture texture.desc) (map (.comp) commands)++data ErasedFetch where+  ErasedFetch :: FetchBindings m -> ErasedFetch++data ErasedCam where+  ErasedCam :: a -> ErasedCam++eraseFetches :: [ErasedBinding] -> [ErasedFetch]+eraseFetches =+  map+    ( \(ErasedBinding (m :: m) _ _) ->+        case eqT @m @MaterialType of+          Nothing -> undefined+          Just Refl -> eraseFetch m+    )++eraseFetch :: MaterialType -> ErasedFetch+eraseFetch (MaterialType (_ :: Proxy m)) = ErasedFetch $ fetch @m++-- qgetFetches :: [ErasedBinding] -> Query System [ErasedFetch]+-- qgetFetches [] = pure []+-- qgetFetches (ErasedBinding (_ :: Proxy m) _ : xs) = do+--   !fetch <- qlift $ single [q|(FetchBindings m)|]+--   ((ErasedFetch $ unwrap fetch) :) <$> qgetFetches xs++qfetchCam :: CameraEntity -> [ErasedFetch] -> Query System [(ErasedFetch, ErasedCam)]+qfetchCam c x = for x $ \(ErasedFetch f) -> do+  FetchBindings {camera} <- pure f+  v <- camera c+  pure (ErasedFetch f, ErasedCam v)++qfetchBindings :: [(ErasedFetch, ErasedCam)] -> MeshEntity -> Query System [ErasedBindingValue]+qfetchBindings [] _ = pure []+qfetchBindings ((ErasedFetch !f, ErasedCam (!a :: a)) : xs) e = do+  FetchBindings {mesh, result} <- pure f+  b <- mesh e+  let res = result (unsafeCoerce a) b+  (ErasedBindingValue res :) <$> qfetchBindings xs e++-- fetchExtensionsCam :: forall m. (Material m) => CameraEntity -> Query System [ErasedBindingValue]+-- fetchExtensionsCam c = do+--   let ext = Set.toList $ collectExtBindings++-- fetchExtensions :: forall m. (Material m) => MeshEntity -> CameraEntity -> Query System [ErasedBindingValue]+-- fetchExtensions e c = do+--   let ext = Set.toList $ collectExtBindings @(Extends m)+--   for ext $ \(ErasedBinding _ (_ :: Proxy b)) -> ErasedBindingValue <$> qfetchBinding @b e c
+ src/Mischief/Render/Material/Definition.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Render.Material.Definition where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.State (MonadState (get), put)+import Data.Data+import Data.Foldable+import Data.Kind (Type)+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Foreign (Ptr, nullPtr, with)+import Foreign.C.ConstPtr+import GHC.TypeLits+import Mischief.Assets (Asset (..))+import Mischief.ECS+import Mischief.Math qualified as Math+import Mischief.Render.Core+import Mischief.Render.Texture+import Mischief.Render.TextureFormat+import Mischief.Shader hiding (FragmentOutput, VertexOutput)+import Mischief.Shader.Generation hiding (FragmentOutput)+import Mischief.Shader.Internal.Bindings (Bindable, ErasedBinding (..), ErasedBindingValue, createBindGroup, createBindLayout, dummyBinding)+import Mischief.Shader.Internal.Params+import Mischief.Shader.Internal.State+import Mischief.Shader.Types qualified as ST+import Mischief.WGPU+import Mischief.WGPU.Framework (loadShaderFromBytes)+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General+import Unsafe.Coerce (unsafeCoerce)++newtype DefaultVI f = DefaultVI (BuiltIn f "vertex_index" Uint)+  deriving (Generic)+  deriving anyclass (ShaderParam)++newtype DefaultVO f = DefaultVO+  { pos :: BuiltIn f "position" (Vec 4 ST.Float)+  }+  deriving (Generic)+  deriving anyclass (ShaderParam)++class+  ( Bindable (B a),+    ShaderParam (VI a),+    ShaderParam (VO a),+    Extension (Extends a),+    Typeable a,+    Typeable (B a),+    Typeable (VI a),+    Typeable (VO a),+    Typeable (Extends a),+    Typeable (IsPhantom a)+  ) =>+  Material (a :: Type)+  where+  type VI a :: Type -> Type+  type VO a :: Type -> Type++  type B a :: Type -> Type++  type Extends a :: [Type]+  type Extends a = '[]++  type Extandable a :: Bool+  type Extandable a = True++  type IsPhantom a :: Bool+  type IsPhantom a = False++  vertex :: VI a GPU -> Shader a (VO a GPU)+  default vertex :: (IsPhantom a ~ True) => VI a GPU -> Shader a (VO a GPU)+  vertex = undefined++  fragment :: VO a GPU -> Shader a (ST.Vec 4 ST.Float)+  default fragment :: (IsPhantom a ~ True) => VO a GPU -> Shader a (ST.Vec 4 ST.Float)+  fragment = undefined++  fetch :: FetchBindings (B a)++data PhantomMaterial = PhantomMaterial deriving (Component)++data MaterialType where+  MaterialType :: forall m. (Material m) => Proxy m -> MaterialType+  deriving (Component)++data NoMaterial++-- type StoreData MaterialType = (MaterialType, )+-- storeAsset = undefined++liftExt :: forall a b c. (ExtensionOf b a) => Shader a c -> Shader b c+liftExt (Shader a) = Shader a++class Extension (a :: [Type]) where+  collectExtBindings :: Set ErasedBinding++instance {-# OVERLAPS #-} Extension '[] where+  collectExtBindings = Set.empty++instance (Extension xs, Material a) => Extension (a : xs) where+  collectExtBindings = Set.unions [Set.singleton $ ErasedBinding (MaterialType $ Proxy @a) (Proxy @a) (Proxy @(B a)), collectExtBindings @(Extends a), collectExtBindings @xs]++collectBindings :: forall m. (Material m) => Set ErasedBinding+collectBindings = Set.union (Set.singleton $ ErasedBinding (MaterialType $ Proxy @m) (Proxy @m) (Proxy @(B m))) $ collectExtBindings @(Extends m)++type ExtensionOf a b = (Material a, IsExtensionOf a b ~ True)++type family IsExtensionOf a b where+  IsExtensionOf a NoMaterial = True+  IsExtensionOf a b = IsExtensionOf' '[a] b++type family IsExtensionOf' (m :: [Type]) (target :: Type) :: Bool where+  IsExtensionOf' '[] a = False+  IsExtensionOf' (a : xs) a = True+  IsExtensionOf' (a : xs) t = Or (IsExtensionOf' (Extends a) t) (IsExtensionOf' xs t)++type family Or a b where+  Or False False = False+  Or a b = True++-- type family ExtendsMaterialRec (e :: Maybe Type) (target :: Type) :: Bool where+--   ExtendsMaterialRec Nothing t = False+--   ExtendsMaterialRec (Just m) t = IsExtensionOf m t++bindings :: forall a. (Material a) => Shader a (B a GPU)+bindings = do+  ShaderState {dict} <- get+  (ErasedValue a) <- pure $ unwrap $ Map.lookup (typeRep $ Proxy @a) dict+  pure $ unsafeCoerce a++extension :: forall e a. (Material e, ExtensionOf a e) => Shader a (B e GPU)+extension = do+  ShaderState {dict} <- get+  (ErasedValue a) <- pure $ unwrap $ Map.lookup (typeRep $ Proxy @e) dict+  pure $ unsafeCoerce a++convertFrag :: forall m. (VO m GPU -> Shader m (ST.Vec 4 ST.Float)) -> VO m GPU -> Shader m (FragmentOutput GPU)+convertFrag s v = do+  s' <- s v+  pure $ FragmentOutput s'++data FetchBindings b where+  FetchBindings ::+    forall x y b.+    (Bindable b) =>+    { camera :: CameraEntity -> Query System x,+      mesh :: MeshEntity -> Query System y,+      result :: x -> y -> b CPU+    } ->+    FetchBindings b++newtype FragmentOutput f = FragmentOutput+  { fragOut1 :: Location f 0 (ST.Vec 4 ST.Float)+  }+  deriving stock (Generic)+  deriving anyclass (ShaderParam)++blendState :: WGPUBlendState+blendState =+  WGPUBlendState+    { color =+        WGPUBlendComponent+          { srcFactor = wGPUBlendFactor_SrcAlpha,+            dstFactor = wGPUBlendFactor_OneMinusSrcAlpha,+            operation = wGPUBlendOperation_Add+          },+      alpha =+        WGPUBlendComponent+          { srcFactor = wGPUBlendFactor_One,+            dstFactor = wGPUBlendFactor_OneMinusSrcAlpha,+            operation = wGPUBlendOperation_Add+          }+    }++data DrawCommand bindings = Draw {binds :: [ErasedBindingValue], vertices :: Nat}++drawCommand :: forall m. (Material m) => RenderDevice -> Ptr WGPURenderPassEncoder -> BindLayout -> DrawCommand (B m) -> IO ()+drawCommand device encoder layout (Draw b vert) = do+  bindGroup <- createBindGroup device layout b+  wgpuRenderPassEncoderSetBindGroup encoder 0 bindGroup 0 (ConstPtr nullPtr)+  wgpuRenderPassEncoderDraw encoder (fromIntegral vert) 1 0 0++render :: forall mat. (Material mat) => RenderDevice -> RenderQueue -> RenderPipeline -> RenderOptions -> Texture -> [DrawCommand (B mat)] -> System ()+render (RenderDevice device) (RenderQueue queue) (RenderPipeline pipeline) RenderOptions {clear} (Texture {texture = output}) commands = liftIO $ do+  bindLayout <- createBindLayout (Set.toList $ collectBindings @mat) (RenderDevice device)++  -- bindGroup <- createBindGroup (RenderDevice device) bindLayout b+  -- RenderPipeline pipeline <- createPipeline @mat (RenderDevice device) (toWGPUFormat format)++  frame <- wgpuTextureCreateView output (ConstPtr nullPtr)++  commandEncoder <- withWGPUString "command encoder" $ \label -> do+    let desc = WGPUCommandEncoderDescriptor {nextInChain = nullPtr, label}+    with desc $ \desc -> wgpuDeviceCreateCommandEncoder device desc++  let (clearValue, loadOp) = case clear of+        Clear (Math.V3 a b c) -> (wgpuColor (realToFrac a) (realToFrac b) (realToFrac c) 1, wGPULoadOp_Clear)+        DontClear -> (wgpuColor 0 0 0 1, wGPULoadOp_Load)++  let attachment =+        WGPURenderPassColorAttachment+          { clearValue,+            storeOp = wGPUStoreOp_Store,+            loadOp,+            resolveTarget = nullPtr,+            depthSlice = wGPU_DEPTH_SLICE_UNDEFINED,+            view = frame,+            nextInChain = nullPtr+          }++  renderPassEncoder <- with attachment $ \attachment -> do+    withWGPUString "render pass encoder" $ \label -> do+      let desc =+            WGPURenderPassDescriptor+              { timestampWrites = ConstPtr nullPtr,+                occlusionQuerySet = nullPtr,+                depthStencilAttachment = ConstPtr nullPtr,+                colorAttachments = ConstPtr attachment,+                colorAttachmentCount = 1,+                label,+                nextInChain = nullPtr+              }++      with desc $ \desc -> do+        wgpuCommandEncoderBeginRenderPass commandEncoder (ConstPtr desc)++  when (renderPassEncoder == nullPtr) $ error "Couldn't encode render pass."++  wgpuRenderPassEncoderSetPipeline renderPassEncoder pipeline+  for_ commands $ drawCommand @mat (RenderDevice device) renderPassEncoder bindLayout+  wgpuRenderPassEncoderEnd renderPassEncoder+  wgpuRenderPassEncoderRelease renderPassEncoder++  commandBuffer <- withWGPUString "command buffer" $ \label -> do+    let desc = WGPUCommandBufferDescriptor {label, nextInChain = nullPtr}+    with desc $ \desc -> wgpuCommandEncoderFinish commandEncoder (ConstPtr desc)++  when (commandBuffer == nullPtr) $ error "Couldn't create command buffer."++  with commandBuffer $ \commandBuffer -> do+    wgpuQueueSubmit queue 1 (ConstPtr commandBuffer)++  wgpuCommandBufferRelease commandBuffer+  wgpuCommandEncoderRelease commandEncoder+  wgpuTextureViewRelease frame++data Clear = DontClear | Clear (Math.V3 Prelude.Float)++data RenderOptions = RenderOptions+  { clear :: Clear,+    nvertices :: Nat+  }++instance Default RenderOptions where+  def =+    RenderOptions+      { clear = DontClear,+        nvertices = 6+      }
+ src/Mischief/Render/Material/Instance.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Render.Material.Instance where++import Language.Haskell.TH (Extension (AllowAmbiguousTypes))+import Mischief.ECS+import Mischief.ECS.World.Query.Queryable+import Mischief.Render.Material.Definition+import Mischief.Shader++-- import Mischief.Render.Shader.State++data FetchMaterialData m where+  FetchMaterialData ::+    (Queryable cam cam', Material m) =>+    cam -> (cam' -> Query System (B m CPU)) -> FetchMaterialData m++-- class FetchMaterialData a cam cam' | a -> cam cam'++-- cameraData :: cam+-- fetch :: cam' -> a
+ src/Mischief/Render/Material/Pipeline.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Render.Material.Pipeline where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.State (MonadState (get), put)+import Data.Data+import Data.Foldable+import Data.Kind (Type)+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Foreign (Ptr, nullPtr, with)+import Foreign.C.ConstPtr+import GHC.TypeLits+import Language.Haskell.TH (Extension (AllowAmbiguousTypes))+import Mischief.Assets (Asset (..))+import Mischief.ECS+import Mischief.Math qualified as Math+import Mischief.Render.Core+import Mischief.Render.Material.Definition+import Mischief.Render.Texture+import Mischief.Render.TextureFormat+import Mischief.Shader hiding (FragmentOutput, VertexOutput)+import Mischief.Shader.Generation hiding (FragmentOutput)+import Mischief.Shader.Internal.Bindings (Bindable, ErasedBinding (..), ErasedBindingValue, createBindGroup, createBindLayout, dummyBinding)+import Mischief.Shader.Internal.Params+import Mischief.Shader.Internal.State+import Mischief.Shader.Types qualified as ST+import Mischief.WGPU+import Mischief.WGPU.Framework (loadShaderFromBytes)+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++data PipelineKey = PipelineKey+  { materialType :: TypeRep,+    format :: WGPUTextureFormat+  }+  deriving (Eq, Ord)++newtype PipelineCache = PipelineCache (Map PipelineKey RenderPipeline) deriving anyclass (Component)++qgetPipeline :: forall mat. (Material mat) => TextureFormat -> Query System RenderPipeline+qgetPipeline format' = do+  let format = toWGPUFormat format'+  device <- qres+  qlift $ do+    PipelineCache cache <- resOrInsert $ PipelineCache Map.empty++    let key =+          PipelineKey+            { materialType = typeRep $ Proxy @mat,+              format+            }++    case Map.lookup key cache of+      Just pipeline -> pure pipeline+      Nothing -> liftIO $ createPipeline @mat device format++createPipeline :: forall mat. (Material mat) => RenderDevice -> WGPUTextureFormat -> IO RenderPipeline+createPipeline (RenderDevice device) format = do+  BindLayout bindLayout <- createBindLayout (Set.toList $ collectBindings @mat) (RenderDevice device)++  pipelineLayoutDesc <- with bindLayout $ \bindGroupLayout -> do+    pure $+      WGPUPipelineLayoutDescriptor+        { nextInChain = nullPtr,+          label = WGPUStringView {_data = ConstPtr nullPtr, length = 0},+          bindGroupLayoutCount = 1,+          bindGroupLayouts = ConstPtr {unConstPtr = bindGroupLayout},+          immediateSize = 0+        }++  pipelineLayout <- with pipelineLayoutDesc $ \pipelineLayoutDesc -> do+    wgpuDeviceCreatePipelineLayout device (ConstPtr {unConstPtr = pipelineLayoutDesc})++  -- putStrLn $ "------------------------------------------\n" ++ T.unpack (genShader @mat @(VO mat) @FragmentOutput "fragment" (collectBindings @mat) (convertFrag $ fragment @mat))++  -- putStrLn $ "------------------------------------------\n" ++ T.unpack (genShader @mat @(VI mat) @(VO mat) "vertex" (Set.toList $ collectBindings @mat) (vertex @mat))++  vertShader <- loadShaderFromBytes device (T.encodeUtf8 $ genShader @mat @(VI mat) @(VO mat) "vertex" (Set.toList $ collectBindings @mat) (vertex @mat))+  fragShader <- loadShaderFromBytes device (T.encodeUtf8 $ genShader @mat @(VO mat) @FragmentOutput "fragment" (Set.toList $ collectBindings @mat) (convertFrag $ fragment @mat))++  pipeline <- withWGPUString "main" $ \vertexEntry -> do+    withWGPUString "main" $ \fragmentEntry -> do+      withWGPUString "render pipeline" $ \label -> do+        let multisample =+              WGPUMultisampleState+                { nextInChain = nullPtr,+                  count = 1,+                  mask = 0xFFFFFFFF,+                  alphaToCoverageEnabled = wgpuFalse+                }++        let primitive =+              newWGPUPrimitiveState+                { topology = wGPUPrimitiveTopology_TriangleList+                }+        with blendState $ \blend -> do+          let target =+                WGPUColorTargetState+                  { nextInChain = nullPtr,+                    format,+                    blend = ConstPtr blend,+                    writeMask = wGPUColorWriteMask_All+                  }++          let vertex =+                newVertexState+                  { entryPoint = vertexEntry,+                    _module = vertShader,+                    _WGPUVertexState = Proxy+                  }++          with target $ \target -> do+            let fragment =+                  newFragmentState+                    { entryPoint = fragmentEntry,+                      _module = fragShader,+                      _WGPUFragmentState = Proxy,+                      targetCount = 1,+                      targets = ConstPtr target+                    }++            with fragment $ \fragment -> do+              let pipelineDesc =+                    WGPURenderPipelineDescriptor+                      { nextInChain = nullPtr,+                        label,+                        layout = pipelineLayout,+                        vertex,+                        multisample,+                        primitive,+                        fragment = ConstPtr fragment,+                        depthStencil = ConstPtr nullPtr+                      }++              with pipelineDesc $ \desc -> wgpuDeviceCreateRenderPipeline device desc++  pure $ RenderPipeline pipeline
+ src/Mischief/Render/Plugin.hs view
@@ -0,0 +1,167 @@+module Mischief.Render.Plugin where++import Control.Monad+import Control.Monad.IO.Class+import Data.Data (Proxy (..))+import Data.Default+import Data.Foldable (for_)+import Data.Text qualified as T+import Data.Traversable+import Foreign (Storable (peek), free, malloc, nullPtr, with)+import Foreign.C.ConstPtr (ConstPtr (..))+import GHC.Generics+import Linear (V3 (..))+import Mischief.Assets.Asset (store)+import Mischief.ECS hiding (get, set)+import Mischief.ECS.Relationships.Order (Before (..))+import Mischief.ECS.Systems qualified as Systems+import Mischief.ECS.World.Query (queryOne)+import Mischief.Materials qualified as Mat+import Mischief.Materials.Sprite (SpriteMaterial)+import Mischief.Math (TransformPlugin)+import Mischief.Render.Bind+import Mischief.Render.Buffer+import Mischief.Render.Camera+import Mischief.Render.Core+import Mischief.Render.Material qualified as Material+import Mischief.Render.Material.Definition+import Mischief.Render.Material.Pipeline (qgetPipeline)+import Mischief.Render.Sprite (SpritePlugin (..), fetchSpriteBindings)+import Mischief.Render.Texture+import Mischief.Render.Texture qualified as Texture+import Mischief.Render.Time (TimeMaterialPlugin)+import Mischief.SDL (SDLPlugin (..))+import Mischief.SDL.Window+import Mischief.Shader (Bindable, Binding, BuiltIn, GPU, Location, Shader, ShaderParam, sample, var)+import Mischief.Shader.Internal.Bindings hiding (Bindings)+import Mischief.Shader.Types qualified as ST+import Mischief.WGPU+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++data RenderPlugin = RenderPlugin deriving (Eq)++instance Plugin RenderPlugin where+  init = do+    first <- scheduleEntity @RenderFirst+    prepare <- scheduleEntity @RenderPrepare+    update <- scheduleEntity @RenderUpdate+    transparent <- scheduleEntity @RenderTransparent+    postprocess <- scheduleEntity @RenderPostprocess+    last <- scheduleEntity @RenderLast++    update' <- scheduleEntity @PostUpdate++    insert (Rel Before first) update'+    insert (Rel Before prepare) first+    insert (Rel Before update) prepare+    insert (Rel Before transparent) update+    insert (Rel Before postprocess) transparent+    insert (Rel Before last) postprocess++    for_ [first, update, prepare, transparent, postprocess, last] $ insert UpdateSchedule++    insertRes =<< liftIO (RenderInstance <$> wgpuCreateInstance)+    void $ spawn $ Observer onAddWindow+    void $ spawn $ Observer onSetWindowSize++    systems renderCameras+      & schedule @RenderLast++    systems clearCameras+      & schedule @RenderFirst++  deps = [dep @SDLPlugin, dep @SpritePlugin, dep @CameraPlugin, dep @TimeMaterialPlugin, dep @TransformPlugin]++-- TODO: refactor this to use the query monad+renderCameras :: System ()+renderCameras = do+  resources <- getRenderingResources+  case resources of+    Nothing -> pure ()+    Just (adapter, device, queue) -> do+      cameras <- query [q|CameraTexture, OutputTo -> (RenderSurface)|]+      for_ cameras $ \(CameraTexture SwappableTexture {currentTexture = texture}, From _ surface) -> do+        format <- getFormat surface adapter+        withSurfaceTexture surface (def {Texture.format}) $ \output -> do+          sampler <- newSampler device+          tex <- liftIO $ wgpuTextureCreateView texture (ConstPtr nullPtr)+          let command = Draw [ErasedBindingValue Bindings {tex = TextureView tex, sampler}] 3+          Just pipeline <- queryOne $ qgetPipeline @DummyFullscreenMaterial format+          render @DummyFullscreenMaterial device queue pipeline def output [command]+          presentSurface surface++clearCameras :: System ()+clearCameras = query_ $ do+  device <- qres+  queue <- qres+  (CameraTexture SwappableTexture {currentTexture = texture, desc}) <- [q|CameraTexture|]+  pipeline <- qgetPipeline @DummyFullscreenMaterial desc.format+  qlift $ render @ClearMaterial device queue pipeline def {clear = Clear $ V3 0.184313725 0.211764706 0.250980392} (Texture texture desc) []++withSurfaceTexture :: RenderSurface -> TextureDescriptor -> (Texture -> System a) -> System ()+withSurfaceTexture (RenderSurface surface) desc f = do+  surfaceTextureBox <- liftIO malloc+  liftIO $ wgpuSurfaceGetCurrentTexture surface surfaceTextureBox+  surfaceTexture <- liftIO $ peek surfaceTextureBox++  unless (surfaceTexture.texture == nullPtr) $ void $ f (Texture {texture = surfaceTexture.texture, desc})++  liftIO $ free surfaceTextureBox++presentSurface :: RenderSurface -> System ()+presentSurface (RenderSurface surface) = liftIO $ wgpuSurfacePresent surface++data Bindings f = Bindings+  { tex :: Binding f Texture,+    sampler :: Binding f Sampler+  }+  deriving (Generic, Bindable)++newtype VertexInput f = VertexInput (BuiltIn f "vertex_index" Mat.Uint)+  deriving stock (Generic)+  deriving anyclass (Mat.ShaderParam)++data VertexOutput f = VertexOutput+  { pos :: Mat.BuiltIn f "position" (Mat.Vec 4 Mat.Float),+    uv :: Mat.Location f 0 (Mat.Vec 2 Mat.Float)+  }+  deriving (Generic, Mat.ShaderParam)++-- | Material for rendering something to the whole screen.+data DummyFullscreenMaterial++instance Material DummyFullscreenMaterial where+  type VI DummyFullscreenMaterial = VertexInput+  type VO DummyFullscreenMaterial = VertexOutput+  type B DummyFullscreenMaterial = Bindings++  vertex :: VertexInput GPU -> Shader DummyFullscreenMaterial (VertexOutput GPU)+  vertex = liftExt . vertexShader++  fragment :: VertexOutput GPU -> Shader DummyFullscreenMaterial (Mat.Vec 4 Mat.Float)+  fragment input = do+    b <- Mat.bindings+    pure $ Mat.sample b.tex b.sampler input.uv++data ClearMaterial++data NoBindings f = NoBindings deriving (Generic, Bindable)++instance Material ClearMaterial where+  type VI ClearMaterial = VertexInput+  type VO ClearMaterial = VertexOutput+  type B ClearMaterial = NoBindings+  vertex = liftExt . vertexShader++  fragment _ = pure $ Mat.vec4 0 0 0 0++vertexShader :: VertexInput GPU -> Shader NoMaterial (VertexOutput GPU)+vertexShader (VertexInput index) = do+  positions <- Mat.var $ Mat.array @(Mat.Vec 2 Mat.Float) [Mat.vec2 (-1) (-1), Mat.vec2 3 (-1), Mat.vec2 (-1) 3]+  let pos = positions Mat.!! index+  pure $+    VertexOutput+      { pos = Mat.vec4 pos.x pos.y 0 1,+        uv = Mat.vec2 (pos.x Mat.* 0.5 + 0.5) (1.0 Mat.- (pos.y Mat.* 0.5 Mat.+ 0.5))+      }
+ src/Mischief/Render/Sprite.hs view
@@ -0,0 +1,85 @@+{-# OPTIONS_GHC -Wno-partial-fields #-}++module Mischief.Render.Sprite where++import Data.Text qualified as T+import Linear.V4+import Mischief.ECS+import Mischief.Materials.Sprite (Bindings (..), SpriteData (..))+import Mischief.Math hiding (qd)+import Mischief.Math.Quat qualified as Quat+import Mischief.Math.Transform+import Mischief.Render.Buffer+import Mischief.Render.Camera+import Mischief.Render.Core+import Mischief.Render.Image+import Mischief.Render.Material.Definition+import Mischief.Render.Sprite.Common+import Mischief.Render.Texture++data SpritePlugin++instance Plugin SpritePlugin where+  init = do+    systems updateSpriteData+      & schedule @RenderPrepare+  deps = [dep @ImageUploadingPlugin]++updateSpriteData :: System ()+updateSpriteData = query_ $ do+  (sprite, Sprite {image}, GlobalTransform spriteT, slice', SpriteFlip {x = flipX, y = flipY}, buffer, Anchor anchor) <-+    [q|Entity, Sprite, GlobalTransform, Maybe SpriteSlice, SpriteFlip, Maybe (Buffer SpriteData), Anchor+      / Without (Buffer SpriteData) || Changed GlobalTransform || Changed Sprite || Changed SpriteSlice || Changed SpriteFlip || Changed Anchor|]++  ImageTexture Texture {desc} <- qget image [qd|ImageTexture|]++  queue <- qres+  device <- qres++  qlift $ do+    buffer <- case buffer of+      Just b -> pure b+      Nothing -> do+        buffer <- createBuffer @SpriteData device+        insert buffer sprite+        pure buffer++    let scale = V2 spriteT.scale.x spriteT.scale.y++    let size = case slice' of+          Just SpriteSlice {size = V2 x y} -> V2 (fromIntegral x) (fromIntegral y) * scale+          Nothing -> V2 (fromIntegral desc.width) (fromIntegral desc.height) * scale++    let slice = case slice' of+          Just SpriteSlice {start, size} ->+            V4+              (fromIntegral start.x / fromIntegral desc.width)+              (fromIntegral start.y / fromIntegral desc.height)+              (fromIntegral size.x / fromIntegral desc.width)+              (fromIntegral size.y / fromIntegral desc.height)+          Nothing -> V4 0 0 1 1++    let calcFlip x = if x then 1 else 0+    let flip = V2 (calcFlip flipY) (calcFlip flipX)++    let anchorOffset = (anchor - V2 0.5 0.5) * size+    let rotation = transpose $ Quat.toMat3 spriteT.rotation++    uploadBuffer queue buffer (SpriteData {coords = spriteT.translation + V3 anchorOffset.x anchorOffset.y 0, size, slice, flip, rotation})++fetchSpriteBindings :: FetchBindings Bindings+fetchSpriteBindings =+  FetchBindings+    ( \camera -> do+        (DefaultSampler sampler) <- qres @DefaultSampler+        CameraMatrices matrices <- qget camera [qd|CameraMatrices|]+        pure (matrices, sampler)+    )+    ( \sprite -> do+        (Sprite {image}, buffer) <- qget sprite [qd|Sprite, (Buffer SpriteData)|]+        ImageTextureView texture <- qget image [qd|ImageTextureView|]+        pure (buffer, texture)+    )+    (\(matrices, sampler) (buffer, texture) -> Bindings {matrices, sampler, sprite = buffer, texture})++-- newtype SpriteBuffer = SpriteBuffer (Buffer SpriteData) deriving anyclass (Component)
+ src/Mischief/Render/Sprite/Common.hs view
@@ -0,0 +1,27 @@+module Mischief.Render.Sprite.Common where++import Linear (V2 (..))+import Mischief.ECS+import Mischief.Math (Transform)+import Mischief.Render.Buffer+import Mischief.Render.Layers (RenderLayers)+import Mischief.Shader.Internal.Buffers+import Mischief.Shader.Types (Vec)+import Mischief.Shader.Types qualified as ST++newtype Sprite = Sprite {image :: Entity}++instance Component Sprite where+  required = require @(SpriteFlip, Anchor, Transform, RenderLayers)++data SpriteSlice = SpriteSlice {start :: V2 Int, size :: V2 Int} deriving (Component, Eq, Show)++data SpriteFlip = SpriteFlip {x :: Bool, y :: Bool} deriving (Component)++instance Default SpriteFlip where+  def = SpriteFlip {x = False, y = False}++newtype Anchor = Anchor (V2 Float) deriving anyclass (Component)++instance Default Anchor where+  def = Anchor $ V2 0.5 0.5
+ src/Mischief/Render/Texture.hs view
@@ -0,0 +1,164 @@+module Mischief.Render.Texture where++import Codec.Picture qualified as P+import Codec.Picture.Extra (scaleBilinear)+import Control.Applicative.Singletons+import Control.Monad.IO.Class+import Data.Default (Default (def))+import Data.Maybe.Singletons (SMaybe (SJust))+import Data.Singletons+import Data.Vector.Storable (Vector)+import Data.Vector.Storable qualified as VS+import Foreign (Bits ((.|.)), Ptr, Word32, Word8, castPtr, nullPtr, with)+import Foreign.C.ConstPtr (ConstPtr (..))+import GHC.TypeLits+import Mischief.Assets+import Mischief.Assets.Image+import Mischief.ECS+import Mischief.Render.Core+import Mischief.Render.TextureFormat+import Mischief.WGPU+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++data Texture = Texture {texture :: Ptr WGPUTexture, desc :: TextureDescriptor}++data SwappableTexture = SwappableTexture {currentTexture :: Ptr WGPUTexture, otherTexture :: Ptr WGPUTexture, desc :: TextureDescriptor}++extractTexture :: SwappableTexture -> Texture+extractTexture SwappableTexture {currentTexture, desc} = Texture currentTexture desc++swapTexture :: SwappableTexture -> (SwappableTexture, Texture)+swapTexture SwappableTexture {currentTexture, otherTexture, desc} = (SwappableTexture {currentTexture = otherTexture, otherTexture = currentTexture, desc}, Texture currentTexture desc)++newtype TextureView = TextureView (Ptr WGPUTextureView)++data TextureDescriptor = TextureDescriptor+  { width :: Int,+    height :: Int,+    depth :: Int,+    label :: String,+    mipLevels :: Int,+    samples :: Int,+    format :: TextureFormat,+    usages :: [TextureUsage]+  }+  deriving (Show)++instance Default TextureDescriptor where+  def = textureDescriptor++textureDescriptor :: TextureDescriptor+textureDescriptor =+  TextureDescriptor+    { width = 1,+      height = 1,+      depth = 1,+      label = "texture",+      mipLevels = 1,+      samples = 1,+      format = RGBA8UnormSrgb,+      usages = [TextureUsageTextureBinding, TextureUsageCopyDst, TextureUsageRenderAttachment]+    }++data TextureUsage+  = TextureUsageNone+  | TextureUsageCopySrc+  | TextureUsageCopyDst+  | TextureUsageTextureBinding+  | TextureUsageStorageBinding+  | TextureUsageRenderAttachment+  | TextureUsageTransientAttachment+  deriving (Show)++usageBits :: TextureUsage -> WGPUTextureUsage+usageBits TextureUsageNone = wGPUTextureUsage_None+usageBits TextureUsageCopySrc = wGPUTextureUsage_CopySrc+usageBits TextureUsageCopyDst = wGPUTextureUsage_CopyDst+usageBits TextureUsageTextureBinding = wGPUTextureUsage_TextureBinding+usageBits TextureUsageStorageBinding = wGPUTextureUsage_StorageBinding+usageBits TextureUsageRenderAttachment = wGPUTextureUsage_RenderAttachment+usageBits TextureUsageTransientAttachment = wGPUTextureUsage_TransientAttachment++processUsages :: [TextureUsage] -> WGPUTextureUsage+processUsages = foldr ((.|.) . usageBits) (WGPUTextureUsage (WGPUFlags 0))++createSwappableTexture :: RenderDevice -> TextureDescriptor -> IO SwappableTexture+createSwappableTexture device desc = do+  a <- createTexture' device desc+  b <- createTexture' device desc+  pure $ SwappableTexture a b desc++createTexture :: RenderDevice -> TextureDescriptor -> IO Texture+createTexture device desc = (`Texture` desc) <$> createTexture' device desc++createTexture' :: RenderDevice -> TextureDescriptor -> IO (Ptr WGPUTexture)+createTexture' (RenderDevice device) descriptor = liftIO $ do+  let TextureDescriptor {width, height, depth, label, mipLevels, samples, format, usages} = descriptor+  withWGPUString label $ \label -> do+    let desc =+          WGPUTextureDescriptor+            { size = WGPUExtent3D (fromIntegral width) (fromIntegral height) (fromIntegral depth),+              label,+              mipLevelCount = fromIntegral mipLevels,+              sampleCount = fromIntegral samples,+              dimension = wGPUTextureDimension_2D,+              format = toWGPUFormat format,+              usage = processUsages usages,+              nextInChain = nullPtr,+              viewFormatCount = 0,+              viewFormats = ConstPtr nullPtr+            }++    with desc (wgpuDeviceCreateTexture device . ConstPtr)++getDimension :: (Int, Int, Int) -> WGPUTextureDimension+getDimension (_, 1, 1) = wGPUTextureDimension_1D+getDimension (_, _, 1) = wGPUTextureDimension_2D+getDimension (_, _, _) = wGPUTextureDimension_3D++uploadImage :: RenderQueue -> Image -> Texture -> IO ()+uploadImage (RenderQueue queue) (Image image) (Texture {texture, desc = TextureDescriptor {width, height}}) = do+  let (P.Image w h bytes) = scaleBilinear width height (P.convertRGBA8 image)++  let extent = WGPUExtent3D (fromIntegral w) (fromIntegral h) 1+  let copyInfo =+        WGPUTexelCopyTextureInfo+          { texture,+            mipLevel = 0,+            origin = WGPUOrigin3D 0 0 0,+            aspect = wGPUTextureAspect_All+          }++  let layout =+        WGPUTexelCopyBufferLayout+          { offset = 0,+            bytesPerRow = 4 * fromIntegral w,+            rowsPerImage = fromIntegral h+          }++  VS.unsafeWith bytes $ \pixelPtr -> do+    with extent $ \extent -> do+      with copyInfo $ \copyInfo -> do+        with layout $ \layout -> do+          wgpuQueueWriteTexture queue (ConstPtr copyInfo) (ConstPtr $ castPtr pixelPtr) (fromIntegral $ VS.length bytes) (ConstPtr layout) (ConstPtr extent)++createTextureForImage :: RenderDevice -> Image -> IO Texture+createTextureForImage device (Image image) = do+  let (P.Image w h _) = P.convertRGBA8 image+  createTexture+    device+    TextureDescriptor+      { width = w,+        height = h,+        depth = 1,+        label = "texture",+        mipLevels = 1,+        samples = 1,+        format = RGBA8UnormSrgb,+        usages = [TextureUsageTextureBinding, TextureUsageCopyDst]+      }++createView :: Texture -> System TextureView+createView Texture {texture} = liftIO $ TextureView <$> wgpuTextureCreateView texture (ConstPtr nullPtr)
+ src/Mischief/Render/TextureFormat.hs view
@@ -0,0 +1,321 @@+module Mischief.Render.TextureFormat where++import Mischief.WGPU.Types.Enums++data TextureFormat+  = Undefined+  | R8Unorm+  | R8Snorm+  | R8Uint+  | R8Sint+  | R16Unorm+  | R16Snorm+  | R16Uint+  | R16Sint+  | R16Float+  | RG8Unorm+  | RG8Snorm+  | RG8Uint+  | RG8Sint+  | R32Float+  | R32Uint+  | R32Sint+  | RG16Unorm+  | RG16Snorm+  | RG16Uint+  | RG16Sint+  | RG16Float+  | RGBA8Unorm+  | RGBA8UnormSrgb+  | RGBA8Snorm+  | RGBA8Uint+  | RGBA8Sint+  | BGRA8Unorm+  | BGRA8UnormSrgb+  | RGB10A2Uint+  | RGB10A2Unorm+  | RG11B10Ufloat+  | RGB9E5Ufloat+  | RG32Float+  | RG32Uint+  | RG32Sint+  | RGBA16Unorm+  | RGBA16Snorm+  | RGBA16Uint+  | RGBA16Sint+  | RGBA16Float+  | RGBA32Float+  | RGBA32Uint+  | RGBA32Sint+  | Stencil8+  | Depth16Unorm+  | Depth24Plus+  | Depth24PlusStencil8+  | Depth32Float+  | Depth32FloatStencil8+  | BC1RGBAUnorm+  | BC1RGBAUnormSrgb+  | BC2RGBAUnorm+  | BC2RGBAUnormSrgb+  | BC3RGBAUnorm+  | BC3RGBAUnormSrgb+  | BC4RUnorm+  | BC4RSnorm+  | BC5RGUnorm+  | BC5RGSnorm+  | BC6HRGBUfloat+  | BC6HRGBFloat+  | BC7RGBAUnorm+  | BC7RGBAUnormSrgb+  | ETC2RGB8Unorm+  | ETC2RGB8UnormSrgb+  | ETC2RGB8A1Unorm+  | ETC2RGB8A1UnormSrgb+  | ETC2RGBA8Unorm+  | ETC2RGBA8UnormSrgb+  | EACR11Unorm+  | EACR11Snorm+  | EACRG11Unorm+  | EACRG11Snorm+  | ASTC4x4Unorm+  | ASTC4x4UnormSrgb+  | ASTC5x4Unorm+  | ASTC5x4UnormSrgb+  | ASTC5x5Unorm+  | ASTC5x5UnormSrgb+  | ASTC6x5Unorm+  | ASTC6x5UnormSrgb+  | ASTC6x6Unorm+  | ASTC6x6UnormSrgb+  | ASTC8x5Unorm+  | ASTC8x5UnormSrgb+  | ASTC8x6Unorm+  | ASTC8x6UnormSrgb+  | ASTC8x8Unorm+  | ASTC8x8UnormSrgb+  | ASTC10x5Unorm+  | ASTC10x5UnormSrgb+  | ASTC10x6Unorm+  | ASTC10x6UnormSrgb+  | ASTC10x8Unorm+  | ASTC10x8UnormSrgb+  | ASTC10x10Unorm+  | ASTC10x10UnormSrgb+  | ASTC12x10Unorm+  | ASTC12x10UnormSrgb+  | ASTC12x12Unorm+  | ASTC12x12UnormSrgb+  | Force32+  deriving (Show)++toWGPUFormat :: TextureFormat -> WGPUTextureFormat+toWGPUFormat Undefined = wGPUTextureFormat_Undefined+toWGPUFormat R8Unorm = wGPUTextureFormat_R8Unorm+toWGPUFormat R8Snorm = wGPUTextureFormat_R8Snorm+toWGPUFormat R8Uint = wGPUTextureFormat_R8Uint+toWGPUFormat R8Sint = wGPUTextureFormat_R8Sint+toWGPUFormat R16Unorm = wGPUTextureFormat_R16Unorm+toWGPUFormat R16Snorm = wGPUTextureFormat_R16Snorm+toWGPUFormat R16Uint = wGPUTextureFormat_R16Uint+toWGPUFormat R16Sint = wGPUTextureFormat_R16Sint+toWGPUFormat R16Float = wGPUTextureFormat_R16Float+toWGPUFormat RG8Unorm = wGPUTextureFormat_RG8Unorm+toWGPUFormat RG8Snorm = wGPUTextureFormat_RG8Snorm+toWGPUFormat RG8Uint = wGPUTextureFormat_RG8Uint+toWGPUFormat RG8Sint = wGPUTextureFormat_RG8Sint+toWGPUFormat R32Float = wGPUTextureFormat_R32Float+toWGPUFormat R32Uint = wGPUTextureFormat_R32Uint+toWGPUFormat R32Sint = wGPUTextureFormat_R32Sint+toWGPUFormat RG16Unorm = wGPUTextureFormat_RG16Unorm+toWGPUFormat RG16Snorm = wGPUTextureFormat_RG16Snorm+toWGPUFormat RG16Uint = wGPUTextureFormat_RG16Uint+toWGPUFormat RG16Sint = wGPUTextureFormat_RG16Sint+toWGPUFormat RG16Float = wGPUTextureFormat_RG16Float+toWGPUFormat RGBA8Unorm = wGPUTextureFormat_RGBA8Unorm+toWGPUFormat RGBA8UnormSrgb = wGPUTextureFormat_RGBA8UnormSrgb+toWGPUFormat RGBA8Snorm = wGPUTextureFormat_RGBA8Snorm+toWGPUFormat RGBA8Uint = wGPUTextureFormat_RGBA8Uint+toWGPUFormat RGBA8Sint = wGPUTextureFormat_RGBA8Sint+toWGPUFormat BGRA8Unorm = wGPUTextureFormat_BGRA8Unorm+toWGPUFormat BGRA8UnormSrgb = wGPUTextureFormat_BGRA8UnormSrgb+toWGPUFormat RGB10A2Uint = wGPUTextureFormat_RGB10A2Uint+toWGPUFormat RGB10A2Unorm = wGPUTextureFormat_RGB10A2Unorm+toWGPUFormat RG11B10Ufloat = wGPUTextureFormat_RG11B10Ufloat+toWGPUFormat RGB9E5Ufloat = wGPUTextureFormat_RGB9E5Ufloat+toWGPUFormat RG32Float = wGPUTextureFormat_RG32Float+toWGPUFormat RG32Uint = wGPUTextureFormat_RG32Uint+toWGPUFormat RG32Sint = wGPUTextureFormat_RG32Sint+toWGPUFormat RGBA16Unorm = wGPUTextureFormat_RGBA16Unorm+toWGPUFormat RGBA16Snorm = wGPUTextureFormat_RGBA16Snorm+toWGPUFormat RGBA16Uint = wGPUTextureFormat_RGBA16Uint+toWGPUFormat RGBA16Sint = wGPUTextureFormat_RGBA16Sint+toWGPUFormat RGBA16Float = wGPUTextureFormat_RGBA16Float+toWGPUFormat RGBA32Float = wGPUTextureFormat_RGBA32Float+toWGPUFormat RGBA32Uint = wGPUTextureFormat_RGBA32Uint+toWGPUFormat RGBA32Sint = wGPUTextureFormat_RGBA32Sint+toWGPUFormat Stencil8 = wGPUTextureFormat_Stencil8+toWGPUFormat Depth16Unorm = wGPUTextureFormat_Depth16Unorm+toWGPUFormat Depth24Plus = wGPUTextureFormat_Depth24Plus+toWGPUFormat Depth24PlusStencil8 = wGPUTextureFormat_Depth24PlusStencil8+toWGPUFormat Depth32Float = wGPUTextureFormat_Depth32Float+toWGPUFormat Depth32FloatStencil8 = wGPUTextureFormat_Depth32FloatStencil8+toWGPUFormat BC1RGBAUnorm = wGPUTextureFormat_BC1RGBAUnorm+toWGPUFormat BC1RGBAUnormSrgb = wGPUTextureFormat_BC1RGBAUnormSrgb+toWGPUFormat BC2RGBAUnorm = wGPUTextureFormat_BC2RGBAUnorm+toWGPUFormat BC2RGBAUnormSrgb = wGPUTextureFormat_BC2RGBAUnormSrgb+toWGPUFormat BC3RGBAUnorm = wGPUTextureFormat_BC3RGBAUnorm+toWGPUFormat BC3RGBAUnormSrgb = wGPUTextureFormat_BC3RGBAUnormSrgb+toWGPUFormat BC4RUnorm = wGPUTextureFormat_BC4RUnorm+toWGPUFormat BC4RSnorm = wGPUTextureFormat_BC4RSnorm+toWGPUFormat BC5RGUnorm = wGPUTextureFormat_BC5RGUnorm+toWGPUFormat BC5RGSnorm = wGPUTextureFormat_BC5RGSnorm+toWGPUFormat BC6HRGBUfloat = wGPUTextureFormat_BC6HRGBUfloat+toWGPUFormat BC6HRGBFloat = wGPUTextureFormat_BC6HRGBFloat+toWGPUFormat BC7RGBAUnorm = wGPUTextureFormat_BC7RGBAUnorm+toWGPUFormat BC7RGBAUnormSrgb = wGPUTextureFormat_BC7RGBAUnormSrgb+toWGPUFormat ETC2RGB8Unorm = wGPUTextureFormat_ETC2RGB8Unorm+toWGPUFormat ETC2RGB8UnormSrgb = wGPUTextureFormat_ETC2RGB8UnormSrgb+toWGPUFormat ETC2RGB8A1Unorm = wGPUTextureFormat_ETC2RGB8A1Unorm+toWGPUFormat ETC2RGB8A1UnormSrgb = wGPUTextureFormat_ETC2RGB8A1UnormSrgb+toWGPUFormat ETC2RGBA8Unorm = wGPUTextureFormat_ETC2RGBA8Unorm+toWGPUFormat ETC2RGBA8UnormSrgb = wGPUTextureFormat_ETC2RGBA8UnormSrgb+toWGPUFormat EACR11Unorm = wGPUTextureFormat_EACR11Unorm+toWGPUFormat EACR11Snorm = wGPUTextureFormat_EACR11Snorm+toWGPUFormat EACRG11Unorm = wGPUTextureFormat_EACRG11Unorm+toWGPUFormat EACRG11Snorm = wGPUTextureFormat_EACRG11Snorm+toWGPUFormat ASTC4x4Unorm = wGPUTextureFormat_ASTC4x4Unorm+toWGPUFormat ASTC4x4UnormSrgb = wGPUTextureFormat_ASTC4x4UnormSrgb+toWGPUFormat ASTC5x4Unorm = wGPUTextureFormat_ASTC5x4Unorm+toWGPUFormat ASTC5x4UnormSrgb = wGPUTextureFormat_ASTC5x4UnormSrgb+toWGPUFormat ASTC5x5Unorm = wGPUTextureFormat_ASTC5x5Unorm+toWGPUFormat ASTC5x5UnormSrgb = wGPUTextureFormat_ASTC5x5UnormSrgb+toWGPUFormat ASTC6x5Unorm = wGPUTextureFormat_ASTC6x5Unorm+toWGPUFormat ASTC6x5UnormSrgb = wGPUTextureFormat_ASTC6x5UnormSrgb+toWGPUFormat ASTC6x6Unorm = wGPUTextureFormat_ASTC6x6Unorm+toWGPUFormat ASTC6x6UnormSrgb = wGPUTextureFormat_ASTC6x6UnormSrgb+toWGPUFormat ASTC8x5Unorm = wGPUTextureFormat_ASTC8x5Unorm+toWGPUFormat ASTC8x5UnormSrgb = wGPUTextureFormat_ASTC8x5UnormSrgb+toWGPUFormat ASTC8x6Unorm = wGPUTextureFormat_ASTC8x6Unorm+toWGPUFormat ASTC8x6UnormSrgb = wGPUTextureFormat_ASTC8x6UnormSrgb+toWGPUFormat ASTC8x8Unorm = wGPUTextureFormat_ASTC8x8Unorm+toWGPUFormat ASTC8x8UnormSrgb = wGPUTextureFormat_ASTC8x8UnormSrgb+toWGPUFormat ASTC10x5Unorm = wGPUTextureFormat_ASTC10x5Unorm+toWGPUFormat ASTC10x5UnormSrgb = wGPUTextureFormat_ASTC10x5UnormSrgb+toWGPUFormat ASTC10x6Unorm = wGPUTextureFormat_ASTC10x6Unorm+toWGPUFormat ASTC10x6UnormSrgb = wGPUTextureFormat_ASTC10x6UnormSrgb+toWGPUFormat ASTC10x8Unorm = wGPUTextureFormat_ASTC10x8Unorm+toWGPUFormat ASTC10x8UnormSrgb = wGPUTextureFormat_ASTC10x8UnormSrgb+toWGPUFormat ASTC10x10Unorm = wGPUTextureFormat_ASTC10x10Unorm+toWGPUFormat ASTC10x10UnormSrgb = wGPUTextureFormat_ASTC10x10UnormSrgb+toWGPUFormat ASTC12x10Unorm = wGPUTextureFormat_ASTC12x10Unorm+toWGPUFormat ASTC12x10UnormSrgb = wGPUTextureFormat_ASTC12x10UnormSrgb+toWGPUFormat ASTC12x12Unorm = wGPUTextureFormat_ASTC12x12Unorm+toWGPUFormat ASTC12x12UnormSrgb = wGPUTextureFormat_ASTC12x12UnormSrgb+toWGPUFormat Force32 = wGPUTextureFormat_Force32++fromWGPUFormat :: WGPUTextureFormat -> TextureFormat+fromWGPUFormat x+  | x == wGPUTextureFormat_Undefined = Undefined+  | x == wGPUTextureFormat_R8Unorm = R8Unorm+  | x == wGPUTextureFormat_R8Snorm = R8Snorm+  | x == wGPUTextureFormat_R8Uint = R8Uint+  | x == wGPUTextureFormat_R8Sint = R8Sint+  | x == wGPUTextureFormat_R16Unorm = R16Unorm+  | x == wGPUTextureFormat_R16Snorm = R16Snorm+  | x == wGPUTextureFormat_R16Uint = R16Uint+  | x == wGPUTextureFormat_R16Sint = R16Sint+  | x == wGPUTextureFormat_R16Float = R16Float+  | x == wGPUTextureFormat_RG8Unorm = RG8Unorm+  | x == wGPUTextureFormat_RG8Snorm = RG8Snorm+  | x == wGPUTextureFormat_RG8Uint = RG8Uint+  | x == wGPUTextureFormat_RG8Sint = RG8Sint+  | x == wGPUTextureFormat_R32Float = R32Float+  | x == wGPUTextureFormat_R32Uint = R32Uint+  | x == wGPUTextureFormat_R32Sint = R32Sint+  | x == wGPUTextureFormat_RG16Unorm = RG16Unorm+  | x == wGPUTextureFormat_RG16Snorm = RG16Snorm+  | x == wGPUTextureFormat_RG16Uint = RG16Uint+  | x == wGPUTextureFormat_RG16Sint = RG16Sint+  | x == wGPUTextureFormat_RG16Float = RG16Float+  | x == wGPUTextureFormat_RGBA8Unorm = RGBA8Unorm+  | x == wGPUTextureFormat_RGBA8UnormSrgb = RGBA8UnormSrgb+  | x == wGPUTextureFormat_RGBA8Snorm = RGBA8Snorm+  | x == wGPUTextureFormat_RGBA8Uint = RGBA8Uint+  | x == wGPUTextureFormat_RGBA8Sint = RGBA8Sint+  | x == wGPUTextureFormat_BGRA8Unorm = BGRA8Unorm+  | x == wGPUTextureFormat_BGRA8UnormSrgb = BGRA8UnormSrgb+  | x == wGPUTextureFormat_RGB10A2Uint = RGB10A2Uint+  | x == wGPUTextureFormat_RGB10A2Unorm = RGB10A2Unorm+  | x == wGPUTextureFormat_RG11B10Ufloat = RG11B10Ufloat+  | x == wGPUTextureFormat_RGB9E5Ufloat = RGB9E5Ufloat+  | x == wGPUTextureFormat_RG32Float = RG32Float+  | x == wGPUTextureFormat_RG32Uint = RG32Uint+  | x == wGPUTextureFormat_RG32Sint = RG32Sint+  | x == wGPUTextureFormat_RGBA16Unorm = RGBA16Unorm+  | x == wGPUTextureFormat_RGBA16Snorm = RGBA16Snorm+  | x == wGPUTextureFormat_RGBA16Uint = RGBA16Uint+  | x == wGPUTextureFormat_RGBA16Sint = RGBA16Sint+  | x == wGPUTextureFormat_RGBA16Float = RGBA16Float+  | x == wGPUTextureFormat_RGBA32Float = RGBA32Float+  | x == wGPUTextureFormat_RGBA32Uint = RGBA32Uint+  | x == wGPUTextureFormat_RGBA32Sint = RGBA32Sint+  | x == wGPUTextureFormat_Stencil8 = Stencil8+  | x == wGPUTextureFormat_Depth16Unorm = Depth16Unorm+  | x == wGPUTextureFormat_Depth24Plus = Depth24Plus+  | x == wGPUTextureFormat_Depth24PlusStencil8 = Depth24PlusStencil8+  | x == wGPUTextureFormat_Depth32Float = Depth32Float+  | x == wGPUTextureFormat_Depth32FloatStencil8 = Depth32FloatStencil8+  | x == wGPUTextureFormat_BC1RGBAUnorm = BC1RGBAUnorm+  | x == wGPUTextureFormat_BC1RGBAUnormSrgb = BC1RGBAUnormSrgb+  | x == wGPUTextureFormat_BC2RGBAUnorm = BC2RGBAUnorm+  | x == wGPUTextureFormat_BC2RGBAUnormSrgb = BC2RGBAUnormSrgb+  | x == wGPUTextureFormat_BC3RGBAUnorm = BC3RGBAUnorm+  | x == wGPUTextureFormat_BC3RGBAUnormSrgb = BC3RGBAUnormSrgb+  | x == wGPUTextureFormat_BC4RUnorm = BC4RUnorm+  | x == wGPUTextureFormat_BC4RSnorm = BC4RSnorm+  | x == wGPUTextureFormat_BC5RGUnorm = BC5RGUnorm+  | x == wGPUTextureFormat_BC5RGSnorm = BC5RGSnorm+  | x == wGPUTextureFormat_BC6HRGBUfloat = BC6HRGBUfloat+  | x == wGPUTextureFormat_BC6HRGBFloat = BC6HRGBFloat+  | x == wGPUTextureFormat_BC7RGBAUnorm = BC7RGBAUnorm+  | x == wGPUTextureFormat_BC7RGBAUnormSrgb = BC7RGBAUnormSrgb+  | x == wGPUTextureFormat_ETC2RGB8Unorm = ETC2RGB8Unorm+  | x == wGPUTextureFormat_ETC2RGB8UnormSrgb = ETC2RGB8UnormSrgb+  | x == wGPUTextureFormat_ETC2RGB8A1Unorm = ETC2RGB8A1Unorm+  | x == wGPUTextureFormat_ETC2RGB8A1UnormSrgb = ETC2RGB8A1UnormSrgb+  | x == wGPUTextureFormat_ETC2RGBA8Unorm = ETC2RGBA8Unorm+  | x == wGPUTextureFormat_ETC2RGBA8UnormSrgb = ETC2RGBA8UnormSrgb+  | x == wGPUTextureFormat_EACR11Unorm = EACR11Unorm+  | x == wGPUTextureFormat_EACR11Snorm = EACR11Snorm+  | x == wGPUTextureFormat_EACRG11Unorm = EACRG11Unorm+  | x == wGPUTextureFormat_EACRG11Snorm = EACRG11Snorm+  | x == wGPUTextureFormat_ASTC4x4Unorm = ASTC4x4Unorm+  | x == wGPUTextureFormat_ASTC4x4UnormSrgb = ASTC4x4UnormSrgb+  | x == wGPUTextureFormat_ASTC5x4Unorm = ASTC5x4Unorm+  | x == wGPUTextureFormat_ASTC5x4UnormSrgb = ASTC5x4UnormSrgb+  | x == wGPUTextureFormat_ASTC5x5Unorm = ASTC5x5Unorm+  | x == wGPUTextureFormat_ASTC5x5UnormSrgb = ASTC5x5UnormSrgb+  | x == wGPUTextureFormat_ASTC6x5Unorm = ASTC6x5Unorm+  | x == wGPUTextureFormat_ASTC6x5UnormSrgb = ASTC6x5UnormSrgb+  | x == wGPUTextureFormat_ASTC6x6Unorm = ASTC6x6Unorm+  | x == wGPUTextureFormat_ASTC6x6UnormSrgb = ASTC6x6UnormSrgb+  | x == wGPUTextureFormat_ASTC8x5Unorm = ASTC8x5Unorm+  | x == wGPUTextureFormat_ASTC8x5UnormSrgb = ASTC8x5UnormSrgb+  | x == wGPUTextureFormat_ASTC8x6Unorm = ASTC8x6Unorm+  | x == wGPUTextureFormat_ASTC8x6UnormSrgb = ASTC8x6UnormSrgb+  | x == wGPUTextureFormat_ASTC8x8Unorm = ASTC8x8Unorm+  | x == wGPUTextureFormat_ASTC8x8UnormSrgb = ASTC8x8UnormSrgb+  | x == wGPUTextureFormat_ASTC10x5Unorm = ASTC10x5Unorm+  | x == wGPUTextureFormat_ASTC10x5UnormSrgb = ASTC10x5UnormSrgb+  | x == wGPUTextureFormat_ASTC10x6Unorm = ASTC10x6Unorm+  | x == wGPUTextureFormat_ASTC10x6UnormSrgb = ASTC10x6UnormSrgb+  | x == wGPUTextureFormat_ASTC10x8Unorm = ASTC10x8Unorm+  | x == wGPUTextureFormat_ASTC10x8UnormSrgb = ASTC10x8UnormSrgb+  | x == wGPUTextureFormat_ASTC10x10Unorm = ASTC10x10Unorm+  | x == wGPUTextureFormat_ASTC10x10UnormSrgb = ASTC10x10UnormSrgb+  | x == wGPUTextureFormat_ASTC12x10Unorm = ASTC12x10Unorm+  | x == wGPUTextureFormat_ASTC12x10UnormSrgb = ASTC12x10UnormSrgb+  | x == wGPUTextureFormat_ASTC12x12Unorm = ASTC12x12Unorm+  | x == wGPUTextureFormat_ASTC12x12UnormSrgb = ASTC12x12UnormSrgb+  | x == wGPUTextureFormat_Force32 = Force32+  | otherwise = undefined
+ src/Mischief/Render/Time.hs view
@@ -0,0 +1,36 @@+module Mischief.Render.Time where++import Mischief.ECS+import Mischief.ECS.Time (Time (elapsed), elapsed, specToSecs, timeMaybe)+import Mischief.Materials.Time+import Mischief.Render.Buffer+import Mischief.Render.Core++data TimeMaterialPlugin++instance Plugin TimeMaterialPlugin where+  init = do+    runWhen+      ( do+          device <- res @RenderDevice+          queue <- res @RenderQueue+          pure $ (,) <$> device <*> queue+      )+      $ \(device, queue) -> do+        x <- createBuffer @TimeData device+        uploadBuffer queue x (TimeData 0)+        insertRes x++    schedule @Update $ systems updateTime++updateTime :: System ()+updateTime = do+  t <- timeMaybe+  case t of+    Nothing -> pure ()+    Just t' -> do+      let t = specToSecs t'.elapsed+      query_ $ do+        queue <- qres @RenderQueue+        buffer <- qres @(Buffer TimeData)+        qlift $ uploadBuffer queue buffer (TimeData t)
+ src/Mischief/Render/Tutorial/Basics.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Your First Shader]("Mischief.Render.Tutorial.Start.Shader")+--+-- [Next Chapter: Shaders]("Mischief.Render.Tutorial.Shaders")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Basics+  ( -- * 2.1. Sprites+    -- $intro++    -- * Windows and Cameras+    -- $cameras++    -- * Sprites+    -- $sprites++    -- * [Next Chapter: Shaders]("Mischief.Render.Tutorial.Shaders")+  )+where++import Mischief.Animation+import Mischief.Assets+import Mischief.ECS+import Mischief.Materials qualified as Mat+import Mischief.Materials.Fullscreen qualified as Full+import Mischief.Materials.Sprite qualified as Sprite+import Mischief.Math+import Mischief.Math.Transform qualified as Transform+import Mischief.Render+import Mischief.Render.Camera++-- $intro+-- This chapter will go over some of the basic rendering tools and how to use them.++-- $cameras+-- In order to get anything to render, you will need to spawn a window, and a camera that outputs to it.+--+-- @+-- window <- 'spawn' 'Window'+-- 'spawn_' ('Camera', 'Rel' 'OutputTo' window)+-- @+--+-- The window can be given a title using @'WindowTitle'@, a size using @'WindowSize'@ and flags using @'WindowFlags'@. You can find+-- more info in "Mischief.SDL.Window".+--+-- Each camera has a 'CameraTexture' component containing its texture. A view to the texture can be obtained using+-- 'cameraView'. Alternatively, 'cameraSwapView' will give you the view while swapping the actual camera's texture to a secondary one,+-- so that you can both read and output to it at the same time.++-- $sprites+-- In order to spawn a sprite you need to give it the entity of an Image asset. You also need to+-- provide it a material.+--+-- @+-- img <- 'load' \@'Image' \"foo.png\"+-- spawn_ ('Sprite' img, 'WithMaterial' \@'Sprite.SpriteMaterial')+-- @+--+-- Sprites accept all forms of transform manipulation: movement, rotation, scaling.+--+-- @+-- -- rotating all sprites by 0.2+-- 'query_' $ do+--   (entity, transform) <- ['q'|Entity, Transform / With Sprite|]+--   'qlift' $ 'insert' (Transform.'Transform.rotateZ' 0.2) entity+-- @+--+-- You can insert a custom @SpriteSlice@ to make the sprite only a slice of its texture:+--+-- @+-- 'insert' ('SpriteSlice' ('V2' 30 0) ('V2' 50 50))+-- @+--+-- You can set a custom @SpriteFlip@ to flip the sprite horizontally or vertically:+--+-- @+-- 'insert' ('SpriteFlip' {x = True, y = False}) sprite+-- @+--+-- Internally, the information from all these components is uploaded into a @'Sprite.SpriteData'@ buffer on each entity, which is bound to the materials+-- extending 'Sprite.SpriteMaterial'. It is then used when calling 'Sprite.sampleSprite'.
+ src/Mischief/Render/Tutorial/Materials.hs view
@@ -0,0 +1,287 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Shaders]("Mischief.Render.Tutorial.Shaders")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Materials+  ( -- * 2.3. Materials+    -- $intro++    -- * Vertex Input and Output+    -- $vivo++    -- * Bindings+    -- $bindings++    -- * Buffers+    -- $buffers++    -- * Running+    -- $running++    -- * Fullscreen+    -- $fullscreen++    -- * Postprocessing+    -- $postprocessing+  )+where++import Mischief.Animation+import Mischief.ECS+import Mischief.Materials qualified as Mat+import Mischief.Materials.Fullscreen qualified as Full+import Mischief.Materials.Sprite qualified as Sprite+import Mischief.Math+import Mischief.Render++-- $intro+-- This chapter will walk you through the important notions and tools for writing Materials.+--+-- A Material is esentially the shader that renders objects from the world onto a texture (generally a camera's texture).+--+-- A Material can be applied to an entity by inserting a @WithMaterial@ component on it:+--+-- @+-- 'insert' ('WithMaterial' \@'Sprite.SpriteMaterial') bob+-- @+--+-- Each material has an associated VertexInput (@VI@), a VertexOutput (@VO@), and a set of Bindings (@B@).++-- $running+-- To \'run\' a material, use one of the @'renderMaterial'@ and @'renderSortedMaterial'@ functions. These are typically+-- scheduled to run each frame, in a Render schedule.+--+-- @+-- 'systems' ('renderMaterial' \@MyMaterial)+--   & 'schedule' \@'RenderUpdate'+-- @++-- $vivo+-- @VI@ is the input to the vertex shader. It contains a @Uint@, the index of the current vertex. (other types of draw calls will be supported in the future). This is the standard way of writing it:+--+-- @+-- newtype VertexInput f = VertexInput ('Mat.BuiltIn' f \"vertex_index\" Uint)+--   deriving ('Generic', 'Mat.ShaderParam')+-- @+--+-- @VO@ is the output of the vertex shader and the input to the fragment shader. It always contains the builtin parameter @position@, indicating the world position of the vertex. The other parameters+-- are added with @Location@ and a unique index. A common @VO@ looks something like this:+--+-- @+-- data VertexOutput f = VertexOutput+--   { pos :: 'Mat.BuiltIn' f \"position\" ('Mat.Vec4' 'Mat.Float'),+--     uv :: 'Mat.Location' f 0 ('Mat.Vec2' 'Mat.Float')+--   }+--   deriving ('Generic', 'Mat.ShaderParam')+-- @+--+-- The vertex and fragment shaders of material @M@ are two functions that look like this:+--+-- @+-- vertex :: 'Mat.VI' M 'GPU' -> 'Mat.Shader' M ('Mat.VO' M 'GPU')+-- @+--+-- @+-- fragment :: 'Mat.VO' M 'GPU'-> 'Mat.Shader' M ('Mat.Vec4' 'Mat.Float')+-- @+--+-- The 'GPU' applied on the types is their shader representation. The above types become:+--+-- @+-- VertexInput(Uint)+-- @+--+-- @+-- VertexOutput {+--   pos :: 'Mat.Vec4' 'Mat.Float',+--   uv :: 'Mat.Vec2' 'Mat.Float'+-- }+-- @++-- $bindings+-- The Bindings of a Material are data that's passed into the shaders from outside. Bindings can contain Textures, Samplers and Buffers.+--+-- @+-- data Bindings f = Bindings {+--     texture :: 'Mat.Binding' f 'Mat.Texture'+--     sampler :: 'Mat.Binding' f 'Mat.Texture',+--     buffer :: 'Mat.Uniform' f SomeBuffer+--   } deriving ('Generic', 'Mat.Bindable')+-- @+--+-- Each Material has a @fetch@ function which is used to specify how you want to fetch the binding data from the world. This is done through+-- a @'Mat.FetchBindings'@ type which contains 3 functions:+--+-- @+-- camera :: [CameraEntity]('Entity') -> 'Query' 'System' x+-- @+--+-- @+-- mesh :: [MeshEntity]('Entity') -> 'Query' 'System' y+-- @+--+-- @+-- result :: x -> y -> b 'CPU'+-- @+--+-- A function grabs some of the data from the camera, one from the mesh (i.e. sprite), and one which combines them to make the Bindings.+--+-- As an example, look at the Bindings and fetch function of @'Sprite.SpriteMaterial'@:+--+-- @+-- data Bindings f = Bindings+--   { matrices :: 'Mat.Uniform' f ('Mischief.Render.Camera.Matrices' f),+--     sprite :: 'Mat.Uniform' f ('Sprite.SpriteData' f),+--     texture :: 'Mat.Binding' f 'Mat.Texture',+--     sampler :: 'Mat.Binding' f 'Mat.Sampler'+--   }+--   deriving ('Generic', 'Mat.Bindable')+-- @+--+-- @+-- fetch =+--   'Mat.FetchBindings'+--     ( \\camera -> do+--         (DefaultSampler sampler) <- 'qres' \@DefaultSampler+--         CameraMatrices matrices <- 'qget' camera [qd|CameraMatrices|]+--         'pure' (matrices, sampler)+--     )+--     ( \\sprite -> do+--         ('Sprite' {image}, buffer) <- 'qget' sprite ['qd'|Sprite, (Buffer SpriteData)|]+--         ImageTextureView texture <- 'qget' image [qd|ImageTextureView|]+--         'pure' (buffer, texture)+--     )+--     (\\(matrices, sampler) (buffer, texture) -\> Bindings {matrices, sampler, sprite = buffer, texture})+-- @+--+-- Inside a @Shader M@, you can request the bindings of material @M@ using @bindings@:+--+-- @+-- b <- 'Mat.bindings'+-- @+--+-- You can also get the bindings of any material which the current material extends using @extension@:+--+-- @+-- b <- 'Mat.extension' \@'Mischief.Materials.Sprite.SpriteMaterial'+-- @++-- $buffers+-- Buffers are data types made of shader primitives, such as:+--+-- @+-- data SpriteData f = SpriteData+--   { coords :: 'Mat.Field' f ('Mat.Vec3' 'Mat.Float'),+--     size :: 'Mat.Field' f ('Mat.Vec2' 'Mat.Float'),+--     slice :: 'Mat.Field' f ('Mat.Vec4' 'Mat.Float'),+--     flip :: 'Mat.Field' f ('Mat.Vec2' 'Mat.Int'),+--     rotation :: 'Mat.Field' f ('Mat.Mat' 3 3)+--   }+--   deriving ('Generic', 'Mat.Bufferable')+-- @+--+-- This is how you create buffers:+--+-- @+-- 'Just' device <- 'res' \@'RenderDevice'+-- buf <- 'createBuffer' \@SpriteData device+-- @+--+-- And how you update them:+--+-- @+-- 'Just' queue <- 'res' \@'RenderQueue'+-- 'uploadBuffer' queue buf SpriteData {...}+-- @+--+-- When uploading, you must use the @'CPU'@ representation of the type. This uses @"Linear"@ types to represent vectors and matrices. For instance, @SpriteData CPU@ looks like this:+--+-- @+-- SpriteData {+--   coords :: 'V3' 'Float'+--   size :: 'V2' 'Float'+--   ...+-- }+-- @+--+-- Each buffer can be inserted on entities as a component, which makes it easy to fetch them.+--+-- If your buffer's CPU representation is also a component, you can schedule @maintainBuffer@. For instance:+-- for instance:+--+-- @+-- instance 'Component' (SpriteData 'CPU')+-- @+--+-- @+-- 'systems' ('maintainBuffer' \@SpriteMaterial)+--   & 'schedule' \@'RenderPrepare'+-- @+--+-- For all entities that have @SpriteData CPU@, it will ensure a @Buffer SpriteData@ component is on them and upload data into it+-- each time it detects a change.++-- $fullscreen+-- To make a fullscreen material, make a material that extends 'Full.FullscreenMaterial' and uses its vertex shader. For instance, to make a material which makes the screen red:+--+-- @+-- data Bindings f = Bindings deriving ('Generic', 'Mat.Bindable')+-- data RedMaterial+--+-- instance 'Mat.Material' RedMaterial where+--   type 'Mat.VI' RedMaterial = Fullscreen.'Full.VertexInput'+--   type 'Mat.VO' RedMaterial = Fullscreen.'Full.VertexOutput'+--   type 'Mat.B' RedMaterial = Bindings+--+--   type 'Mat.Extends' RedMaterial = \'['Full.FullscreenMaterial']+--+--   vertex = 'Mat.liftExt' . 'Mat.vertex' \@'Full.FullscreenMaterial'+--   fragment _ = pure $ 'Mat.vec4' 1 0 0 1+--+--   fetch =+--     'Mat.FetchBindings'+--       ('const' $ 'pure' ())+--       ('const' $ 'pure' ())+--       ('const' $ 'const' $ Bindings)+-- @+--+-- Note that, when rendering, you need to set the number of vertices to 4:+--+-- @+-- 'renderMaterial' \@RedMaterial 'def' {'nvertices' = 4}+-- @++-- $postprocessing+-- A postprocess material is a fullscreen material which also takes its camera's texture as an input, modifying it.+--+-- You can turn the above material into a postprocess material by changing its bindings and its fetch function:+--+-- @+-- data Bindings f = Bindings+--   { texture :: 'Mat.Binding' f 'Mat.Texture',+--     sampler :: 'Mat.Binding' f 'Mat.Sampler'+--   }+--   deriving ('Generic', 'Mat.Bindable')+-- @+--+-- @+-- fetch =+--   'Mat.FetchBindings'+--     ( \\camera -> do+--         (DefaultSampler sampler) <- 'qres' \@DefaultSampler+--         texture <- 'cameraSwapView' camera+--         'pure' (sampler, texture)+--     )+--     ('const' $ 'pure' ())+--     (\\(sampler, texture) _ -> Bindings texture sampler)+-- @+--+-- You can now, for instance, multiply the entire camera's output with red:+--+-- @+-- fragment vo = do+--   Bindings {texture, sampler} <- 'Mat.bindings'+--   'pure' $ 'Mat.sample' texture sampler vo.uv * 'Mat.vec4' 1 0 0 1+-- @
+ src/Mischief/Render/Tutorial/Shaders.hs view
@@ -0,0 +1,130 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Basics]("Mischief.Render.Tutorial.Basics")+--+-- [Next Chapter: Materials]("Mischief.Render.Tutorial.Materials")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Shaders+  ( -- * 2.2. Shaders+    -- $intro++    -- * The Shmonad+    -- $monad++    -- * Types+    -- $types++    -- * Operations+    -- $operations++    -- * Functions+    -- $functions++    -- * [Next Chapter: Materials]("Mischief.Render.Tutorial.Materials")+  )+where++import Mischief.Animation+import Mischief.ECS+import Mischief.Materials+import Mischief.Materials.Fullscreen qualified as Full+import Mischief.Materials.Sprite qualified as Sprite+import Mischief.Math+import Mischief.Render+import Prelude ()+import Prelude qualified++-- $intro+-- This chapter will teach you about writing custom shaders in the @Shader@ monad.++-- $monad+-- The shader monad is a state monad in which you build custom shader code which will then be parsed into actual code.+-- When writing shaders, it is recommended to do the following imports:+--+-- @+-- import "Prelude"()+-- import "Mischief.Materials"+-- @+--+-- Prelude needs to be hidden, as shader code uses its own definition of primitive types and operations. See for instance,+-- @'Prelude.Float'@ vs @'Float'@ and @'Prelude.+'@ vs. @'+'@.++-- $types+-- When working with shaders, there are 3 __primitive types__:+--+-- * 'Int'+-- * 'Uint'+-- * 'Float'+--+-- Each can be built with a literal. For instance, this is a shader that returns 5:+--+-- @+-- five :: 'Shader' a 'Int'+-- five = 'pure' 5+-- @+--+-- There are __vecs__ of between 2 and 4 elements. Each size having its own constructor: 'vec2', 'vec3', 'vec4'.+--+-- @+-- foo :: 'Vec3' 'Float'+-- foo = 'vec3' 3.4 0.1 (-5)+-- @+--+-- There are also __arrays__, which can be of vecs or primitives.+--+-- @+-- bar :: 'Array' ('Vec2' 'Uint')+-- bar = 'array' ['vec2' 5 0, 'vec2' 1 4, 'vec2' 10 3]+-- @+--+-- Arrays can be indexed into using '!!':+--+-- @+-- let x = bar '!!' 2+-- @+--+-- Finally, there are matrices:+--+-- @+-- baz :: 'Mat' 2 3+-- baz = 'mat' ('vec3' 5 0 4, 'vec3' 1 1 1)+-- @+--+-- You can cast between different primitive types, or between vecs of the same size, using @'cast'@.++-- $operations+-- Algebric operators are defined using a convention inspired by "Linear".+--+-- Two elements of the same type can be multiplied using @*@.+--+-- @+-- let a :: 'Float' = 2 '*' 3+-- @+--+-- A scalar (left) can be multiplied with a vector (right) using @*^@, and vice versa for @^*@.+--+-- @+-- let a :: 'Vec2' 'Float' = 2 '*^' 'vec2' 5 2+-- @+--+-- A matrix (left) can be multiplied with a vector (right) using @!*^@, or with a scalar (right) using @!*@. Vice versa+-- for @^*!@ and @*!@.+--+-- The same goes for other operators, such as @/@, @+@, @-@, @%@.++-- $functions+-- Shader functions are defined according to the [wgpu standard](https://www.w3.org/TR/WGSL/] in "Mischief.Shader.Functions".+--+-- If a function you need isn't yet defined by Mischief, you can bind it yourself using @unsafeCall@. For instance, assuming+-- @atan2@ wasn't defined, you could call it like this:+--+-- @+-- let x :: 'Vec2' 'Float' = 'vec2' 5 2+-- let y :: 'Vec2' 'Float' = 'vec2' 1 2+-- let z :: 'Vec2' 'Float' = 'unsafeCall' \"atan2\" ['Param' x, 'Param' y]+-- @+--+-- But be careful! This removes all typechecking. If you call a function with the wrong parameters it will+-- panic.
+ src/Mischief/Render/Tutorial/Start/Animation.hs view
@@ -0,0 +1,312 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Starting Out]("Mischief.Render.Tutorial.Start.Start")+--+-- [Next Chapter: Your First Shader]("Mischief.Render.Tutorial.Start.Shader")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Start.Animation+  ( -- * 1.2. Your First Animation+    -- $intro++    -- * Looking At The Spritesheet+    -- $spritesheet++    -- * Making an Animator+    -- $animator++    -- * Your First Transition+    -- $trans++    -- * A Better Animator+    -- $animator2++    -- * Flipping Your Sprites+    -- $flip++    -- * [Next Chapter: Your First Shader]("Mischief.Render.Tutorial.Start.Shader")+  )+where++import Control.Monad (void)+import Data.Text (Text)+import Mischief.Animation+import Mischief.Assets+import Mischief.ECS+import Mischief.Materials.Sprite (SpriteMaterial)+import Mischief.Math+import Mischief.Render+import Mischief.Render.Plugin++-- $intro+-- This is a continuation of the previous chapter where we'll be animating our sprites.++-- $spritesheet+-- First, grab the @spritesheet.kdl@ and @animations.kdl@ from the [repo](https://codeberg.org/mischief/mischief)+-- and place them in your assets folder.+--+-- Let's take a moment to understand what these files contain.+--+-- The @spritesheet.kdl@ one describes our spritesheet. It specifies its size, the size of each frame, the padding between frames, and+-- it links to the image from before.+--+-- @+-- spritesheet {+--   size 896 896+--   frameSize 128 128+--   padding 0 0+--   image "characters.png"+-- }+-- @+--+-- @animations.kdl@ is a bit more intimidating, but it's way simpler than it appears.+--+-- First, it links to the spritesheet:+--+-- @+-- spritesheet link=\"spritesheet.kdl\"+-- @+--+-- Then, it contains a collection of Animation assets:+--+-- @+-- collection {+--   animation1 {...}+--   animation2 {...}+-- }+-- @+--+-- Each animation specifies the indices of its spritesheet frames, the speed of the animation, and specifies whether it loops or not.+--+-- For instance, this is the idle frame of the green character. If you look at frame @14@ in the spritesheet, you'll see it is in fact the green character standing still.+--+-- @+-- green_idle {+--   frames 14+--   fps 10+-- }+-- @+--+-- Meanwhile, the walking animation of the green character looks like this:+--+-- @+-- green_walk {+--   range 16 17+--   fps 4+--   loop #true+-- }+-- @+--+-- In the following section, we'll need to create various @'AssetRef' 'Animation'@ to point to each animation. So let's practice that for a bit.+--+-- This is how you can point to green's walk animation:+--+-- @+-- greenWalk :: 'AssetRef' 'Animation'+-- greenWalk = do+--   animations :: 'Animations' <- \"animations.kdl\"+--   'pure' $ 'colGetU' \"green_walk\" animations.collection+-- @+--+-- We can also use the @selAnim@ function to do this more easily:+--+-- @+-- greenWalk = 'selAnim' \"animations.kdl\" \"green_walk\"+-- @++-- $animator+-- In order to make an @'Animator'@, we need to make an instance of the @'AnimatorTag'@ typeclass.+--+-- @+-- data MyAnimator = MyAnimator+--+-- instance 'AnimatorTag' MyAnimator where+--   data 'Input' MyAnimator = Input deriving ('Generic', 'Default')+--   data 'Shift' MyAnimator = Shift+--   data 'State' MyAnimator = GreenIdle+--+--   'animation' GreenIdle = 'selAnim' \"animations.kdl\" \"green_idle\"+--+--   'start' = GreenIdle+-- @+--+-- The animator has three components: @Input@, @Shift@, and @State@. We'll learn more about the first two later, but for now what you need to know+-- is that @State@ is the type describing the state of the animator at each given point. In @start@ we need to specify what state the animator is in+-- when it starts. In @animation@ we need to map each possible state to an animation.+--+-- For now we just have one state corresponding to the idle animation of the green character.+--+-- Our @setup@ system is now this:+--+-- @+-- setup :: 'System' ()+-- setup = do+--   window <- 'spawn' 'Window'+--   'spawn_' ('Camera', 'Rel' 'OutputTo' window)+--+--   'spawn_'+--     ( 'Animator' MyAnimator,+--       'Anchor' $ 'V2' 0.5 0.9,+--       'WithMaterial' \@SpriteMaterial,+--       'def' {'translation' = 'V3' (-60) 0 0},+--       Player+--     )+--+--   'spawn_'+--     ( 'Animator' MyAnimator,+--       'Anchor' $ 'V2' 0.5 0.9,+--       'WithMaterial' \@SpriteMaterial,+--       'def' {'translation' = 'V3' 60 0 0}+--     )+-- @+--+-- There's no need to insert a @Sprite@ or @SpriteSlice@ component anymore. The Animator will add them for us. It will also load+-- all the assets necessary to play the animations.+--+-- If you run the app now, you should see that both characters are playing the green idle animation:+--+-- ![image1](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-2-1.png)++-- $trans+-- Next, let's try passing some input into the animator and creating a transition.+--+-- @+-- instance 'AnimatorTag' MyAnimator where+--   data 'Input' MyAnimator = Input {walk :: 'Bool'} deriving ('Generic', 'Default')+--   data 'Shift' MyAnimator = Shift+--   data 'State' MyAnimator = GreenIdle | GreenWalk+--+--   'animation' GreenIdle = 'selAnim' \"animations.kdl\" \"green_idle\"+--   'animation' GreenWalk = 'selAnim' \"animations.kdl\" \"green_walk\"+--+--   'transition' GreenIdle Input {walk = 'True'} _ _ = 'Just' GreenWalk+--   'transition' GreenWalk Input {walk = 'False'} _ _ = 'Just' GreenIdle+--   'transition' _ _ _ _ = 'Nothing'+--+--   'start' = GreenIdle+-- @+--+-- We have added a @walk :: Bool@ field to our Input, a new state, and we have set up two transitions such that, if our character is in the+-- idle state but the input says they're walking, they switch to the walk state, and vice versa.+--+-- All that's left is to actually set the input from outside. We can easily do that from our @movement@ system by adding these lines after calculating @dir@:+--+-- @+-- let walk = 'norm' dir > 0+-- 'input' \@MyAnimator (\\i -\> i {walk}) player+-- @+--+-- You should now see your character walking when you move them!+--+-- ![image2](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-2-2.png)+--+-- What's more, the animations are hot-reloadable. Try modifying the animation in @animations.kdl@ and you should see the changes immediately! (Don't forget to+-- add @'FileWatcherPlugin'@ to your app).++-- $animator2+-- Let's expand our animator to be more generic and able to handle multiple characters:+--+-- @+-- data Character = Green | Pink+--+-- charName :: Character -> 'Text'+-- charName Green = \"green\"+-- charName Pink = \"pink\"+--+-- data AnimationType = Idle | Walk+--+-- instance AnimatorTag MyAnimator where+--   data 'Input' MyAnimator = Input {walk :: 'Bool'} deriving ('Generic', 'Default')+--   data 'Shift' MyAnimator = ChangeCharacter Character+--   data 'State' MyAnimator = Start | CharacterAnimation Character AnimationType+--+--   'animation' (CharacterAnimation c Idle) = 'selAnim' \"animations.kdl\" (charName c <> \"_idle\")+--   'animation' (CharacterAnimation c Walk) = 'selAnim' \"animations.kdl\" (charName c <> \"_walk\")+--   'animation' Start = 'noAnimation'+--+--   'transition' (CharacterAnimation c Idle) Input {walk = 'True'} _ _ = 'Just' (CharacterAnimation c Walk)+--   'transition' (CharacterAnimation c Walk) Input {walk = 'False'} _ _ = 'Just' (CharacterAnimation c Idle)+--   'transition' Start _ ('Just' (ChangeCharacter c)) _ = 'Just' (CharacterAnimation c Idle)+--   'transition' _ _ _ _ = 'Nothing'+--+--   'start' = Start+-- @+--+-- First, we've added a type to define our characters, and a function to convert their name to Text. This is so we can+-- more easily grab each of their animations without having to match on each individual character.+--+-- @+-- data Character = Green | Pink+--+-- charName :: Character -> 'Text'+-- charName Green = \"green\"+-- charName Pink = \"pink\"+-- @+--+-- We've added a new Start state that has no associated animation. The other state, @CharacterAnimation c a@, is the state corresponding to animation @a@+-- of character @c@.+--+-- @+-- data 'State' MyAnimator = Start | CharacterAnimation Character AnimationType+-- @+--+-- The transitions are now generic. We are telling it to transition from the Idle animation of character @c@ to the Walk animation of character @c@ and vice versa.+--+-- @+-- 'transition' (CharacterAnimation c Idle) Input {walk = 'True'} _ _ = 'Just' (CharacterAnimation c Walk)+-- 'transition' (CharacterAnimation c Walk) Input {walk = 'False'} _ _ = 'Just' (CharacterAnimation c Idle)+-- @+--+-- We have also defined a @Shift@. This is esentially an event we can send to the animator to trigger a transition.+--+-- @+-- data 'Shift' MyAnimator = ChangeCharacter Character+-- @+--+-- When this is triggered, it should follow this new transition:+--+-- @+-- 'transition' Start _ ('Just' (ChangeCharacter c)) _ = 'Just' (CharacterAnimation c Idle)+-- @+--+-- When we tell it to change character to @c@, it will transition from Start to the Idle animation of @c@.+--+-- All that's left is to actually trigger that shift when we spawn our characters, otherwise they will be stuck in the Start state:+--+-- @+-- e \<- 'spawn'+--   ( 'Animator' MyAnimator,+--     'Anchor' $ 'V2' 0.5 0.9,+--     'WithMaterial' \@SpriteMaterial,+--     'def' {'translation' = 'V3' (-60) 0 0},+--     Player+--   )+--+-- 'shift' (ChangeCharacter Pink) e+--+-- e <- 'spawn'+--   ( 'Animator' MyAnimator,+--     'Anchor' $ 'V2' 0.5 0.9,+--     'WithMaterial' \@SpriteMaterial,+--     'def' {'translation' = 'V3' 60 0 0}+--   )+--+-- 'shift' (ChangeCharacter Green) e+-- @+--+-- ![image3](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-2-3.png)++-- $flip+-- Alright our characters are now properly animated but there's still something about them. When you move left, the character is still facing right!+--+-- The solution is simple: flip the sprite when they're moving to the left. We can do this through the @SpriteFlip@ component in our movement system:+--+-- @+-- let flip = dir.x < 0+-- 'insert' ('SpriteFlip' {x = False, y = flip}) player+-- @+--+-- That's all!+--+-- ![image4](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-2-4.png)
+ src/Mischief/Render/Tutorial/Start/Shader.hs view
@@ -0,0 +1,190 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Your First Animation]("Mischief.Render.Tutorial.Start.Animation")+--+-- [Next Chapter: Basics]("Mischief.Render.Tutorial.Basics")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Start.Shader+  ( -- * 1.3. Your First Shader+    -- $intro++    -- * Defining a Material+    -- $def++    -- * Your First Buffer+    -- $buf++    -- * [Next Chapter: Basics]("Mischief.Render.Tutorial.Basics")+  )+where++import Mischief.Animation+import Mischief.ECS+import Mischief.Materials qualified as Mat+import Mischief.Materials.Sprite qualified as Sprite+import Mischief.Math+import Mischief.Render++-- $intro+-- In this chapter you'll learn to apply a custom material to your sprites.++-- $def+-- Typically materials are written in separate modules, due to needing their own imports and requiring you to disable the Prelude. So make a new module+-- called @MyMaterial@ (don't forget to add it to your @.cabal@).+--+-- Now copy this code into it:+--+-- @+-- import "Mischief.Materials"+-- import "Mischief.Materials.Sprite" qualified as Sprite+-- import "Prelude" ()+--+-- data Bindings f = Bindings deriving ('Generic', 'Mat.Bindable')+--+-- data MyMaterial+--+-- instance 'Mat.Material' MyMaterial where+--   type 'Mat.VI' MyMaterial = Sprite.'Sprite.VertexInput'+--   type 'Mat.VO' MyMaterial = Sprite.'Sprite.VertexOutput'+--+--   type 'Mat.B' MyMaterial = Bindings+--+--   type Extends MyMaterial = '[Sprite.'Sprite.SpriteMaterial']+--+--   'Mat.vertex' = 'Mat.liftExt' . (vertex @Sprite.'Sprite.SpriteMaterial')+--+--   'Mat.fragment' = undefined+--+--   'Mat.fetch' = undefined+-- @+--+-- As you can see, the material has 3 types, one corresponding to the vertex input, one to the output, and one to the bindings: the data we're passing into the shader.+--+-- For the first two we're just using the ones that @SpriteMaterial@ uses (check the source code over there to see how they're defined),+-- while for the Bindings we've just defined our own data type that contains nothing, for now.+--+-- Each material also needs a vertex and a fragment shader. A vertex shader is responsible for determining the UVs and the placement of vertices, while+-- a fragment shader colors each pixel of the mesh. We are using @liftExt@ to lift the vertex shader from the sprite material (possible only if we extend it). The fragment+-- shader we'll write out in a moment.+--+-- There's also a @fetch@ function which is responsible for grabbing the Bindings from the World. For now we can just set it to this:+--+-- @+-- 'Mat.fetch' =+--   'Mat.FetchBindings'+--     { camera = \\_ -> 'pure' (),+--       mesh = \\_ -> 'pure' (),+--       result = \\_ _ -> Bindings+--     }+-- @+--+-- We are not grabbing any data from the mesh or from the camera, as we don't need it to construct our Bindings.+--+-- Now, for the fragment shader, we'll just sample our sprite and inverse its colors:+--+-- @+-- 'Mat.fragment' vo = do+--   color <- 'Mat.liftExt' $ Sprite.'Sprite.sampleSprite' vo.uv+--   'pure' $ (1 -^ color.rgb) +: color.a+-- @+--+-- @-^@ is what we use to subtract a vector (right) from a scalar (left). You'll see this with a lot of shader operators, it's a convention inspired by "Linear".+-- @+:@ is used to append a scalar to the end of a vector. So that whole operation inverses the rgb values of the sprite's color, while keeping the alpha intact.+--+-- Now you just need to set your sprites to use this instead of the current material. Import it into your previous module:+--+-- @+-- import MyMaterial(MyMaterial)+-- @+--+-- And then replace all occurences of @SpriteMaterial@ with @MyMaterial@. That's it!+--+-- ![image1](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-3-1.png)++-- $buf+-- Let's pass some data into the shader!+--+-- First, we'll need to define a Bufferable type. That is, a type that can be sent to the GPU. Add this to your material module:+--+-- @+-- newtype MyColor f = MyColor ('Mat.Field' f ('Mat.Vec3' 'Mat.Float')) deriving ('Generic', 'Mat.Bufferable')+-- @+--+-- Now add it to your Bindings:+--+-- @+-- newtype Bindings f = Bindings ('Mat.Uniform' f (MyColor f)) deriving ('Generic', 'Mat.Bindable')+-- @+--+-- Next, we need to figure out how we want to fetch this type from the World. The standard way is keeping a @'Buffer' MyColor@ as a component on the sprite.+--+-- So we can set our @fetch@ function to this:+--+-- @+-- 'Mat.fetch' =+--   'Mat.FetchBindings'+--     { camera = \\_ -> 'pure' (),+--       mesh = \\sprite -> 'qget' sprite ['qd'|(Buffer MyColor)|],+--       result = \\_ color -> Bindings color+--     }+-- @+--+-- We'll also modify our fragment shader to use this custom color. For instance, we can multiply it over the sprite's color:+--+-- @+-- 'Mat.fragment' vo = do+--   color <- 'liftExt' $ Sprite.'Sprite.sampleSprite' vo.uv+--   Bindings (MyColor myColor) <- 'Mat.bindings'+--   'pure' $ (myColor * color.rgb) +: color.a+-- @+--+-- The last step is creating the buffers and filling them with the correct data. The easiest way is to make the CPU-side @MyColor@ into a component:+--+-- @+-- instance 'Component' (MyColor 'CPU')+-- @+--+-- And, back on the main module, insert it on the sprites:+--+-- @+-- import MyMaterial(MyColor(..))+-- @+--+-- @+-- e <-+--   'spawn'+--     ( 'Animator' MyAnimator,+--       'Anchor' $ 'V2' 0.5 0.9,+--       'WithMaterial' \@MyMaterial,+--       'def' {'translation' = 'V3' (-60) 0 0},+--       MyColor \@'CPU' ('V3' 1 1 0), -- add this+--       Player+--     )+--+-- 'shift' (ChangeCharacter Pink) e+--+-- e <-+--   'spawn'+--     ( 'Animator' MyAnimator,+--       'Anchor' $ 'V2' 0.5 0.9,+--       'WithMaterial' \@MyMaterial,+--       'def' {'translation' = 'V3' 60 0 0},+--       MyColor \@'CPU' ('V3' 0 1 1) -- and this+--     )+--+-- 'shift' (ChangeCharacter Green) e+-- @+--+-- We can use the @maintainBuffer@ system to automatically upload our data from the CPU component to the buffer. Uploading operations+-- are typically ran in @RenderPrepare@.+--+-- @+-- systems ('maintainBuffer' \@MyColor)+--   & 'schedule' \@'RenderPrepare'+-- @+--+-- All done!+--+-- ![image2](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-3-2.png)
+ src/Mischief/Render/Tutorial/Start/Start.hs view
@@ -0,0 +1,264 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Next Chapter: Your First Animation]("Mischief.Render.Tutorial.Start.Animation")+--+-- [Main Page]("Mischief.Render")+module Mischief.Render.Tutorial.Start.Start+  ( -- * 1.1. Starting Out+    -- $intro++    -- * Your First Sprite+    -- $sprites++    -- * Your Second Sprite+    -- $second++    -- * Moving Your Sprite+    -- $movement++    -- * Sorting Your Sprites+    -- $sorting++    -- * [Next Chapter: Your First Animation]("Mischief.Render.Tutorial.Start.Animation")+  )+where++import Control.Monad (void)+import Mischief.Assets+import Mischief.ECS+import Mischief.Materials.Sprite (SpriteMaterial)+import Mischief.Math+import Mischief.Render+import Mischief.Render.Plugin++-- $intro+-- This chapter will walk you through rendering and moving a few sprites.+--+-- Throughout this tutorial we will be using various resources from the @assets/@ folder in the [repo](https://codeberg.org/mischief/mischief).+--+-- You can find the entire code [here](https://codeberg.org/mischief/mischief/src/branch/main/mischief-render/examples/start).++-- $sprites+-- Download @characters.png@ from the above link and place it in an @assets/@ folder at the root of your project. These+-- are sprites from a free asset pack on [Kenney](https://kenney.nl/).+--+-- Create a new Mischief app, such as this:+--+-- @+-- import "Mischief.ECS"+-- import "Mischief.Math"+-- import "Mischief.Assets"+-- import "Mischief.Render"+-- import "Mischief.Input"+-- import "Mischief.Materials.Sprite"('SpriteMaterial')+--+-- main :: 'IO' ()+-- main = do+--   app <- 'newApp'+--   'setAssetSource' \"assets\/\" app+--   'addPlugin' \@MainPlugin app+--   'runApp' app+--+-- data MainPlugin+--+-- instance 'Plugin' MainPlugin where+--   'init' = 'pure' ()+--+--   'deps' = ['dep' \@'RenderPlugin', 'dep' \@'Mischief.Input.InputPlugin', 'dep' \@'TimePlugin']+-- @+--+-- @RenderPlugin@ is necessary for rendering. @InputPlugin@ and @TimePlugin@ we'll be using later for movement. .+--+-- Now let's write a @setup@ system that spawns a window, camera, and a sprite:+--+-- @+-- setup :: 'System' ()+-- setup = do+--   image <- 'load' \@Image \"characters.png\"+--+--   window <- 'spawn' 'Window'+--   'spawn_' ('Camera', 'Rel' 'OutputTo' window)+--+--   'spawn_'+--     ( 'Sprite' {image},+--       'WithMaterial' \@'SpriteMaterial'+--     )+-- @+--+-- Don't forget to schedule it in @Startup@!+--+-- Additionally, we also need to create a system that renders the sprites:+--+-- @+-- renderSprites :: 'System' ()+-- renderSprites = 'renderMaterial' \@'SpriteMaterial' 'def'+-- @+--+-- And schedule it to run as well:+--+-- @+-- 'init' = do+--   'systems' setup+--     & 'schedule' \@'Startup'+--+--   'systems' renderSprites+--     & 'schedule' \@'RenderUpdate'+-- @+--+-- If you run your app now, you'll see our sprite rendered, but there's an issue! The @characters.png@ file is a spriesheet containing multiple+-- characters and animations. The whole thing is being rendered!+--+-- ![image1](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-1-1.png)+--+-- In order to limit our sprite to just a part of the texture, we can insert a @'SpriteSlice'@. Inside it, we say where the frame we want to select starts, along its size, in pixels.+--+-- @+-- 'spawn_'+--   ( 'Sprite' {image},+--     'SpriteSlice' ('V2' 0 387) ('V2' 128 128),+--     'WithMaterial' \@'SpriteMaterial'+--   )+-- @+--+-- @0 387@ is the position of the idle frame of the pink character in our spritesheet. Don't worry about getting the pixels yourself, we'll soon be doing this automatically through the animator.+--+-- Alright, we are now properly rendering a sprite!+--+-- ![image2](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-1-2.png)++-- $second+-- Let's give our sprite a friend! In order to position them nicely and symmetrically, we should change the transform of the first sprite to be left by some amount, and the transform of the second+-- to be right by that same amount.+--+-- This is our new spawn logic:+--+-- @+-- 'spawn_'+--   ( 'Sprite' {image},+--     'SpriteSlice' ('V2' 0 387) ('V2' 128 128),+--     'WithMaterial' \@'SpriteMaterial',+--     'def' {'translation' = 'V3' (-60) 0 0}+--   )+--+-- 'spawn_'+--   ( 'Sprite' {image},+--     'SpriteSlice' ('V2' 645 129) ('V2' 128 128),+--     'WithMaterial' \@'SpriteMaterial',+--     'def' {'translation' = 'V3' 60 0 0}+--   )+-- @+--+-- Alright we've successfully rendered another sprite!+--+-- ![image3](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-1-3.png)++-- $movement+-- Next, let's set up a system that moves the left sprite based on keyboard input.+--+-- First, we should make sure to mark it in some way to identify it. We can do so by creating and inserting a @Player@ component.+--+-- @+-- data Player = Player deriving ('Component')+-- @+--+-- @+--+-- @+-- 'spawn_'+--   ( 'Sprite' {image},+--     'SpriteSlice' ('V2' 0 387) ('V2' 128 128),+--     'WithMaterial' \@'SpriteMaterial',+--     'def' {'translation' = 'V3' (-60) 0 0},+--     Player+--   )+-- @+--+-- You should now qualify these 3 modules. They contain utilities for processing input, working with transforms, and getting the time.+--+-- @+-- import "Mischief.Input.Keys" qualified as Keys+-- import "Mischief.Math.Transform" qualified as Transform+-- import "Mischief.ECS.Time" qualified as Time+-- @+--+-- Alright now we can finally write our movement system:+--+-- @+-- movement :: 'System' ()+-- movement = do+--   'Just' keys <- 'res' \@Keys+--   'Just' (player, transform) \<- 'single' ['q'|Entity, Transform \/ With Player|]+--+--   delta <- Time.'Mischief.ECS.Time.delta'+--   let speed = 150+--+--   let dirX =+--         if+--           | Keys.'Mischief.ECS.Keys.pressed' keys Keys.A -\> -1+--           | Keys.'Mischief.ECS.Keys.pressed' keys Keys.D -\> 1+--           | otherwise -\> 0+--+--   let dirY =+--         if+--           | Keys.'Mischief.ECS.Keys.pressed' keys Keys.S -\> -1+--           | Keys.'Mischief.ECS.Keys.pressed' keys Keys.W -\> 1+--           | otherwise -\> 0+--+--   let dir = 'normalize' $ 'V3' dirX dirY 0+--+--   'insert' (Transform.'Mischief.Math.Transform.move' (dir ^* delta * speed) transform) player+-- @+--+-- It is relatively straightfoward. We get the Keys resources, along with the entity and transform of our player. The current delta time. We also set an arbitrary speed.+-- Based on the input we set the directions on the X and Y axis respectively. We put them in a V3 and normalize them. We then move the player's transform+-- by that V3 multiplied by the delta and the speed.+--+-- Don't forget to schedule this:+--+-- @+-- 'systems' movement+--   & 'schedule' \@'Update'+-- @+--+-- If you run the app now, you should be able to move the sprite!++-- $sorting+-- You may have noticed a small problem with our current app. If you overlap the two sprites,+-- one of them will always be behind the other.+--+-- ![image4](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-1-4.png)+--+-- The solution is to render the material as sorted instead. We need to provide+-- a function that, for each entity, will pick a key to sort by. The simplest value to use is+-- the sprites' y transform. That will make a sprite render under another if it is placed higher.+--+-- Let's write a function that picks the y translation of each sprite:+--+-- @+-- getY :: 'Entity' -> 'Query' 'System' 'Float'+-- getY entity = do+--   'Transform' {'translation'} \<- ['q'|entity. Transform|]+--   'pure' (-translation.y)+-- @+--+-- Now we can replace our sprite rendering system with this:+--+-- @+-- renderSprites :: 'System' ()+-- renderSprites = 'renderSortedMaterial' \@'SpriteMaterial' 'def' getY+-- @+--+-- Your sprites should now be getting sorted as you move them around. However, you will notice they still don't look quite right.+-- Each sprite's transform is realtive to the center of the frame by default. Meaning they get sorted by their centers, rather than+-- by the position of their feet, as you'd expect.+--+-- We can solve this easily by inserting an @Anchor@ on each sprite:+--+-- @+-- 'Anchor' $ 'V2' 0.5 0.9+-- @+--+-- Everything should be perfect now!+--+-- ![image5](https://codeberg.org/mischief/assets/raw/branch/main/rendering-1-1-5.png)
+ src/Mischief/Shader.hs view
@@ -0,0 +1,30 @@+module Mischief.Shader+  ( Shader (..),+    var,+    comment,+    Bindable,+    Bufferable,+    ShaderParam,+    Field,+    Uniform,+    BuiltIn,+    Binding,+    Location,+    CPU,+    GPU,+    Param (..),+    module Mischief.Shader.Functions,+    module Mischief.Shader.Types,+    module Prelude,+    module Mischief.ECS,+  )+where++import Mischief.ECS hiding ((&))+import Mischief.Shader.Functions+import Mischief.Shader.Internal.Bindings+import Mischief.Shader.Internal.Buffers+import Mischief.Shader.Internal.Params+import Mischief.Shader.Internal.State+import Mischief.Shader.Types+import Prelude (const, pure, show, undefined, ($), (.), type (~))
+ src/Mischief/Shader/Functions.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++module Mischief.Shader.Functions where++import Data.Data+import Data.Singletons (SingI)+import Data.Text (Text)+import GHC.TypeLits hiding (Div)+import Mischief.Render.Core+import Mischief.Render.Texture+import Mischief.Shader.Internal.Bindings+import Mischief.Shader.Internal.Singletons+import Mischief.Shader.Internal.State+import Mischief.Shader.Types+import Prelude (Bool (..), undefined, ($), type (~))++sample :: Expr TTexture -> Expr TSampler -> Vec 2 Float -> Vec 4 Float+sample tex sampler v =+  Function+    "textureSample"+    [ Param tex,+      Param sampler,+      Param v+    ]++unsafeCall :: (SingI a) => Text -> [Param] -> Expr a+unsafeCall = Function++-- Binary+(&) :: (Algebric a ~ True, Integral a ~ True) => Expr a -> Expr a -> Expr a+(&) = CustomOperator "&"++-- Arithmetics++class Num a where+  (+) :: Expr a -> Expr a -> Expr a+  (+) = CustomOperator "+"++  (-) :: Expr a -> Expr a -> Expr a+  (-) = CustomOperator "-"++  (*) :: Expr a -> Expr a -> Expr a+  (*) = CustomOperator "*"++instance Num (Primitive a)++instance Num (VectorType n a)++instance Num (MatrixType n m)++(^+) :: Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType n a)+(^+) = CustomOperator "+"++(+^) :: Expr (Primitive a) -> Expr (VectorType n a) -> Expr (VectorType n a)+(+^) = CustomOperator "+"++(^-) :: Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType n a)+(^-) = CustomOperator "-"++(-^) :: Expr (Primitive a) -> Expr (VectorType n a) -> Expr (VectorType n a)+(-^) = CustomOperator "-"++(^*) :: Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType n a)+(^*) = CustomOperator "*"++(*^) :: Expr (Primitive a) -> Expr (VectorType n a) -> Expr (VectorType n a)+(*^) = CustomOperator "*"++(*!) :: Float -> Mat n m -> Mat n m+(*!) = CustomOperator "*"++(!*) :: Mat n m -> Float -> Mat n m+(!*) = CustomOperator "*"++(^*!) :: Vec m Float -> Mat n m -> Vec n Float+(^*!) = CustomOperator "*"++(!*^) :: Mat n m -> Vec n Float -> Vec m Float+(!*^) = CustomOperator "*"++(!*!) :: Mat k r -> Mat c k -> Mat c r+(!*!) = CustomOperator "*"++class Div a where+  (/) :: Expr a -> Expr a -> Expr a+  (/) = CustomOperator "/"++instance {-# OVERLAPPABLE #-} (Algebric a ~ True) => Div a++(^/) :: Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType n a)+(^/) = CustomOperator "/"++(/^) :: Expr (Primitive a) -> Expr (VectorType n a) -> Expr (VectorType n a)+(/^) = CustomOperator "/"++class Modulo a where+  (%) :: Expr a -> Expr a -> Expr a+  (%) = CustomOperator "%"++instance {-# OVERLAPPABLE #-} (Integral a ~ True) => Modulo a++(^%) :: (Integral (Primitive a) ~ True) => Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType n a)+(^%) = CustomOperator "%"++(%^) :: (Integral (Primitive a) ~ True) => Expr (Primitive a) -> Expr (VectorType n a) -> Expr (VectorType n a)+(%^) = CustomOperator "%"++-- Numeric Functions++abs :: (SingI a, Algebric a ~ True) => Expr a -> Expr a+abs = Abs++acos :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+acos x = Function "acos" [Param x]++acosh :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+acosh x = Function "acosh" [Param x]++asin :: (SingI a, Algebric a ~ True) => Expr a -> Expr a+asin x = Function "asin" [Param x]++asinh :: (SingI a, Algebric a ~ True) => Expr a -> Expr a+asinh x = Function "asinh" [Param x]++atan :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+atan x = Function "atan" [Param x]++atanh :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+atanh x = Function "atanh" [Param x]++atan2 :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a -> Expr a+atan2 x y = Function "atan2" [Param x, Param y]++ceil :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+ceil x = Function "ceil" [Param x]++clamp :: (SingI a, Algebric a ~ True) => Expr a -> Expr a -> Expr a -> Expr a+clamp e low high = Function "clamp" [Param e, Param low, Param high]++cos :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+cos x = Function "cos" [Param x]++cosh :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+cosh x = Function "cosh" [Param x]++countLeadingZeros :: (SingI a, Integral a ~ True) => Expr a -> Expr a+countLeadingZeros x = Function "countLeadingZeros" [Param x]++countOneBits :: (SingI a, Integral a ~ True) => Expr a -> Expr a+countOneBits x = Function "countOneBits" [Param x]++countTrailingZeros :: (SingI a, Integral a ~ True) => Expr a -> Expr a+countTrailingZeros x = Function "countTrailingZeros" [Param x]++cross :: (SingI (VectorType 3 a), Fractional (Expr (Primitive a)) ~ True) => Expr (VectorType 3 a) -> Expr (VectorType 3 a) -> Expr (VectorType 3 a)+cross a b = Function "cross" [Param a, Param b]++degrees :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+degrees x = Function "degrees" [Param x]++determinant :: (SingI n) => Expr (MatrixType n n) -> Float+determinant x = Function "determinant" [Param x]++distance :: (SingI a, Fractional (Expr a) ~ True, VectorOrSingleOf a ~ b) => Expr a -> Expr a -> Expr (Primitive b)+distance a b = Function "distance" [Param a, Param b]++dot :: (SingI (Expr (VectorType n a)), SingI a, SingI n, Algebric (Primitive a) ~ True) => Expr (VectorType n a) -> Expr (VectorType n a) -> Expr (Primitive a)+dot a b = Function "dot" [Param a, Param b]++dot4U8Packed :: Uint -> Uint -> Uint+dot4U8Packed a b = Function "dot4U8Packed" [Param a, Param b]++dot4I8Packed :: Uint -> Uint -> Int+dot4I8Packed a b = Function "dot4I8Packed" [Param a, Param b]++exp :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+exp a = Function "exp" [Param a]++exp2 :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+exp2 a = Function "exp2" [Param a]++extractBits :: (SingI a, Integral a ~ True) => Expr a -> Uint -> Uint -> Expr a+extractBits e offset count = Function "extractBits" [Param e, Param offset, Param count]++faceForward :: (SingI a, SingI n, Fractional (Expr (Primitive a)) ~ True) => Expr (VectorType n a) -> Expr (VectorType n a) -> Expr (VectorType n a) -> Expr (VectorType n a)+faceForward a b c = Function "faceForward" [Param a, Param b, Param c]++firstLeadingBit :: (SingI a, SingI n, Integral a ~ True) => Expr a -> Expr a+firstLeadingBit a = Function "firstLeadingBit" [Param a]++firstTrailingBit :: (SingI a, SingI n, Integral a ~ True) => Expr a -> Expr a+firstTrailingBit a = Function "firstTrailingBit" [Param a]++floor :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+floor x = Function "floor" [Param x]++fma :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a -> Expr a -> Expr a+fma a b c = Function "fma" [Param a, Param b, Param c]++fract :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+fract a = Function "fract" [Param a]++-- TODO: frexp (custom struct)++insertBits :: (SingI a, Integral a ~ True) => Expr a -> Expr a -> Uint -> Uint -> Expr a+insertBits e newbits offset count = Function "insertBits" [Param e, Param newbits, Param offset, Param count]++inverseSqrt :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+inverseSqrt a = Function "inverseSqrt" [Param a]++-- TODO: ldexp++length :: (SingI a, SingI b, SingI n, VectorOrSingleOf b ~ a) => Expr b -> Expr (Primitive a)+length a = Function "length" [Param a]++log :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+log a = Function "log" [Param a]++log2 :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+log2 a = Function "log2" [Param a]++max :: (SingI a, Algebric a ~ True) => Expr a -> Expr a -> Expr a+max a b = Function "max" [Param a, Param b]++min :: (SingI a, Algebric a ~ True) => Expr a -> Expr a -> Expr a+min a b = Function "min" [Param a, Param b]++class Mix a b++instance Mix a a++instance Mix (VectorType n a) (Primitive a)++mix :: (SingI a, SingI b, Fractional (Expr a) ~ True, Fractional (Expr b) ~ True, Mix a b) => Expr a -> Expr a -> Expr b -> Expr a+mix a b c = Function "mix" [Param a, Param b, Param c]++-- TODO: modf (custom struct)++normalize :: (SingI n, SingI a, Fractional (Expr (VectorType n a)) ~ True) => Expr (VectorType n a) -> Expr (VectorType n a)+normalize a = Function "normalize" [Param a]++pow :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a -> Expr a+pow a b = Function "pow" [Param a, Param b]++quantizeToF16 :: (SingI a, VectorOrSingleOf a ~ TFloat) => Expr a -> Expr a+quantizeToF16 a = Function "quantizeToF16" [Param a]++radians :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+radians a = Function "radians" [Param a]++reflect :: (SingI n, SingI a, Fractional (Expr (VectorType n a)) ~ True) => Expr (VectorType n a) -> Expr (VectorType n a) -> Expr (VectorType n a)+reflect a b = Function "reflect" [Param a, Param b]++refract :: (SingI a, SingI b, VectorOrSingleOf a ~ b) => Expr a -> Expr a -> Expr (Primitive b) -> Expr a+refract a b c = Function "refract" [Param a, Param b, Param c]++reverseBits :: (SingI a, Integral a ~ True) => Expr a -> Expr a+reverseBits a = Function "reverseBits" [Param a]++round :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+round a = Function "round" [Param a]++saturate :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+saturate a = Function "saturate" [Param a]++sign :: (SingI a, Algebric a ~ True) => Expr a -> Expr a+sign a = Function "sign" [Param a]++sin :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+sin a = Function "sin" [Param a]++sinh :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+sinh a = Function "sinh" [Param a]++smoothstep :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a -> Expr a -> Expr a+smoothstep a b c = Function "smoothstep" [Param a, Param b, Param c]++sqrt :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+sqrt a = Function "sqrt" [Param a]++step :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a -> Expr a+step a b = Function "step" [Param a, Param b]++tan :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+tan a = Function "tan" [Param a]++tanh :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+tanh a = Function "tanh" [Param a]++transpose :: (SingI n, SingI m) => Expr (MatrixType n m) -> Expr (MatrixType m n)+transpose a = Function "transpose" [Param a]++trunc :: (SingI a, Fractional (Expr a) ~ True) => Expr a -> Expr a+trunc a = Function "trunc" [Param a]++-- TODO: Bit Reinterpretation Functions++-- TODO: Logical Functions++-- TODO: Array Functions++-- TODO: Derivative Functions++-- TODO: Texture Functions++-- TODO: Atomic Functions++-- TODO: Data Packing Functions++-- TODO: Data Unpacking Functions++-- TODO: Synchronization Functions
+ src/Mischief/Shader/Generation.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeAbstractions #-}++module Mischief.Shader.Generation where++import Control.Monad.State hiding (get)+import Data.Data hiding (cast)+import Data.Default+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics+import GHC.TypeLits (KnownNat, Nat, natVal)+import Mischief.Render.Core+import Mischief.Render.Texture+import Mischief.Shader.Functions+import Mischief.Shader.Internal.Bindings+import Mischief.Shader.Internal.Params+import Mischief.Shader.Internal.State+import Mischief.Shader.Types hiding ((<>))+import Unsafe.Coerce (unsafeCoerce)+import Prelude (String, map, pure, show, undefined, ($), (.), (<>))+import Prelude qualified++data Binds f = Binds+  { sampler :: Binding f Sampler,+    texture :: Binding f Texture+  }+  deriving (Generic, Bindable)++data VertexOutput f = VertexOutput+  { position :: BuiltIn f "position" (Vec 4 Float),+    uv :: Location f 0 (Vec 2 Float)+  }+  deriving (Generic, ShaderParam)++newtype FragmentOutput f = FragmentOutput (Location f 0 (Vec 4 Float))+  deriving stock (Generic)+  deriving anyclass (ShaderParam)++-- frag :: Binds -> BuiltIn "location" Vec2f -> Shader (Location 0 Vec4f)+-- frag b input = do+--   let result = sample (get b.texture) (get b.sampler) (get input)+--   pure (set result)++shaderToWGSL :: forall a m. (ShaderParam a) => Map TypeRep ErasedValue -> Shader m (a GPU) -> Text+shaderToWGSL dict (Shader s) = do+  let (a, ShaderState {ast}) = runState s ShaderState {counter = 0, ast = Empty, dict}+  let ast' = case (paramDefinition @a) of+        StructParam n _ -> do+          let Values vs = collectValues a+          let vst = map valueToWGSL vs+          Concat ast (Return (StructInit n vst))+        AnonParam _ _ -> do+          let Values [v] = collectValues a+          Concat ast (Return (unwrapValue v))+  stmtToWGSL ast'++unwrapValue :: forall a. Value -> Expr a+unwrapValue (Value (a :: Expr b)) = unsafeCoerce a++valueToWGSL :: Value -> Text+valueToWGSL (Value (a :: Expr a)) = exprToWGSL a++genFunction :: forall a m. (ShaderParam a) => Text -> Text -> Text -> Map TypeRep ErasedValue -> Shader m (a GPU) -> Text+genFunction name input output dict s = "fn " <> name <> "(" <> input <> ") -> " <> output <> " {\n" <> shaderToWGSL dict s <> "\n}"++genInput :: ParamDefinition -> Text+genInput (StructParam name _) = "input: " <> name+genInput (AnonParam n m) = n <> "input: " <> m++genOutput :: ParamDefinition -> Text+genOutput (StructParam name _) = name+genOutput (AnonParam n m) = n <> m++genShader :: forall m p a. (ShaderParam p, ShaderParam a) => Text -> [ErasedBinding] -> (p GPU -> Shader m (a GPU)) -> Text+genShader tag b s = genBindings 0 b <> genParams (Proxy @p) <> genParams (Proxy @a) <> "@" <> tag <> "\n" <> genFunction "main" (genInput $ paramDefinition @p) (genOutput $ paramDefinition @a) (genDict 0 b) (s dummyParam)++genDict :: Nat -> [ErasedBinding] -> Map TypeRep ErasedValue+genDict _ [] = Map.empty+genDict n (ErasedBinding _ m (_ :: Proxy b) : xs) =+  let (y, n') = dummyBinding @b n+   in Map.union (Map.singleton (typeRep m) (ErasedValue y)) (genDict n' xs)++genBindings :: Nat -> [ErasedBinding] -> Text+genBindings _ [] = ""+genBindings n (ErasedBinding _ _ (_ :: Proxy b) : xs) =+  let (Bindings x, n') = collectBindings n (Proxy @(b Internal))+   in T.concat (map genBinding x) <> "\n" <> genBindings n' xs++genBinding :: BindingData -> Text+genBinding NormalData {bType, index} = "@group(0) @binding(" <> T.pack (show index) <> ")\nvar b" <> T.pack (show index) <> " : " <> bType <> ";\n\n"+genBinding UniformData {structName, structFields, index} =+  "@group(0) @binding(" <> T.pack (show index) <> ")\nvar<uniform> b" <> T.pack (show index) <> " : " <> structName <> ";\n\n" <> genBuffer structName structFields++genBuffer :: Text -> [(Text, Text)] -> Text+genBuffer name fields =+  let fields' = map (\(x, y) -> "  " <> x <> ": " <> y) fields+   in "struct " <> name <> " {\n" <> T.intercalate ",\n" fields' <> "\n};\n\n"++genParams :: forall p. (ShaderParam p) => Proxy p -> Text+genParams _ =+  let definition = paramDefinition @p+   in case definition of+        StructParam name (Params params) -> "struct " <> name <> " {\n" <> T.concat (map genParam params) <> "};\n\n"+        _ -> ""++genParam :: ParamData -> Text+genParam ParamData {pType, index = BuiltInKind s} = "  @builtin(" <> s <> ") " <> s <> " : " <> pType <> ",\n"+genParam ParamData {pType, index = LocKind n} = "  @location(" <> T.pack (show n) <> ") l" <> T.pack (show n) <> " : " <> pType <> ",\n"++genShaderT :: forall m b a p. (Bindable b, ShaderParam p, ShaderParam a) => [ErasedBinding] -> (p GPU -> Shader m (a GPU)) -> String+genShaderT p = T.unpack . genShader "no_tag" p
+ src/Mischief/Shader/Internal/Bindings.hs view
@@ -0,0 +1,467 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wno-partial-fields #-}++module Mischief.Shader.Internal.Bindings where++import Data.Bifunctor qualified+import Data.Data+import Data.Default (Default (def))+import Data.Kind+import Data.Primitive.Ptr+import Data.Singletons (SingI)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector.Storable qualified as VS+import Foreign (Bits ((.|.)), with)+import Foreign.C.ConstPtr+import GHC.Generics (Generic (Rep, from), K1 (K1), M1 (M1), U1 (U1), V1 (..), to, (:*:) ((:*:)))+import GHC.TypeLits+import Mischief.ECS (System)+import Mischief.Render.Buffer (Buffer (..), BufferDescriptor (..))+import Mischief.Render.Core+import Mischief.Render.Texture+import Mischief.Shader.Internal.Buffers qualified as Buffers+import Mischief.Shader.Internal.Singletons+import Mischief.Shader.Internal.State+import Mischief.Shader.Types hiding ((<>))+import Mischief.WGPU+import Mischief.WGPU.Opaque (WGPUBindGroup, WGPUBindGroupLayout)+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++-- data Binding (index :: Nat) a where+--   Binding :: forall b index. Expr (AssociatedExpr b) -> Binding index b+--   BindEntry :: WGPUBindGroupEntry -> Binding index b++-- data Uniform (index :: Nat) a where+--   Uniform :: forall b index. WGPUBindGroupEntry -> Uniform index b++newtype UniformBinding a = UniformBinding a++newtype NormalBinding a = NormalBinding a++type family Binding f a where+  Binding Internal b = NormalBinding b+  Binding CPU Sampler = Sampler+  Binding GPU Sampler = Expr TSampler+  Binding CPU Texture = TextureView+  Binding GPU Texture = Expr TTexture++type family Uniform f a where+  Uniform Internal b = UniformBinding b+  Uniform CPU (a b) = Buffer a+  Uniform GPU (Expr a) = Expr a+  Uniform GPU (a GPU) = a GPU++-- Uniform CPU++-- type family ToGpu a where+--   T++type family AssociatedExpr a where+  AssociatedExpr (Expr a) = a+  AssociatedExpr Texture = TTexture+  AssociatedExpr Sampler = TSampler++-- instance (KnownNat n, SingI (AssociatedExpr a)) => Default (Binding n a) where+--   def = Binding $ BindingVar (natVal (Proxy @n))++data BindingData+  = NormalData+      { bType :: Text,+        index :: Integer+      }+  | UniformData+      { structName :: Text,+        structFields :: [(Text, Text)],+        index :: Integer+      }+  deriving (Show)++newtype Bindings = Bindings [BindingData] deriving newtype (Semigroup, Show)++class (Typeable a) => Bindable a where+  collectBindings :: Nat -> Proxy (a Internal) -> (Bindings, Nat)+  default collectBindings :: (GCollectBindings (Rep (a Internal))) => Nat -> Proxy (a Internal) -> (Bindings, Nat)+  collectBindings n _ = gCollectBindings (Proxy @(Rep (a Internal))) n++  collectLayouts :: Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat)+  default collectLayouts :: (GCollectBindings (Rep (a Internal))) => Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat)+  collectLayouts n _ = gCollectLayouts (Proxy @(Rep (a Internal))) n++  collectEntries :: Nat -> a CPU -> ([WGPUBindGroupEntry], Nat)+  default collectEntries :: (GCollectEntries (Rep (a CPU)) (Rep (a Internal)), Generic (a CPU)) => Nat -> a CPU -> ([WGPUBindGroupEntry], Nat)+  collectEntries n a = gCollectEntries @(Rep (a CPU)) @(Rep (a Internal)) (from a) n++  dummyBinding :: Nat -> (a GPU, Nat)+  default dummyBinding :: (Generic (a GPU), GDummyBinding (Rep (a Internal)) (Rep (a GPU))) => Nat -> (a GPU, Nat)+  dummyBinding n = Data.Bifunctor.first to $ gDummyBinding @(Rep (a Internal)) @(Rep (a GPU)) n++data ErasedBinding where+  ErasedBinding :: forall b (a :: Type) m. (Typeable m, Bindable b, Typeable b, Typeable a) => {materialType :: m, material :: Proxy a, binding :: Proxy b} -> ErasedBinding++instance Eq ErasedBinding where+  ErasedBinding _ a _ == ErasedBinding _ b _ = typeRep a == typeRep b++instance Ord ErasedBinding where+  compare (ErasedBinding _ a _) (ErasedBinding _ b _) = compare (typeRep a) (typeRep b)++data ErasedBindingValue where+  ErasedBindingValue :: (Bindable b, Typeable b) => b CPU -> ErasedBindingValue++class CollectBindings a where+  collectBinding :: Proxy a -> Nat -> BindingData+  collectLayout :: Proxy a -> Nat -> WGPUBindGroupLayoutEntry++class GCollectBindings f where+  gCollectBindings :: Proxy f -> Nat -> (Bindings, Nat)+  gCollectLayouts :: Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)++instance GCollectBindings V1 where+  gCollectBindings _ n = (Bindings [], n)+  gCollectLayouts _ n = ([], n)++instance GCollectBindings U1 where+  gCollectBindings _ n = (Bindings [], n)+  gCollectLayouts _ n = ([], n)++instance (GCollectBindings f, GCollectBindings g) => GCollectBindings (f :*: g) where+  gCollectBindings _ n = do+    let (a, n') = gCollectBindings (Proxy @f) n+    let (b, n'') = gCollectBindings (Proxy @g) n'+    (a <> b, n'')+  gCollectLayouts _ n = do+    let (a, n') = gCollectLayouts (Proxy @f) n+    let (b, n'') = gCollectLayouts (Proxy @g) n'+    (a <> b, n'')++instance (CollectBindings c) => GCollectBindings (K1 i c) where+  gCollectBindings _ n = (Bindings [collectBinding (Proxy @c) n], n + 1)+  gCollectLayouts _ n = ([collectLayout (Proxy @c) n], n + 1)++instance (GCollectBindings f) => GCollectBindings (M1 i t f) where+  gCollectBindings _ = gCollectBindings (Proxy @f)+  gCollectLayouts _ = gCollectLayouts (Proxy @f)++instance CollectBindings (NormalBinding Sampler) where+  collectBinding _ n = NormalData {bType = T.pack "sampler", index = fromIntegral n}+  collectLayout _ n =+    WGPUBindGroupLayoutEntry+      { nextInChain = nullPtr,+        binding = fromIntegral n,+        visibility = wGPUShaderStage_Fragment .|. wGPUShaderStage_Vertex,+        bindingArraySize = 0,+        buffer = unusedBufferLayout,+        storageTexture = unusedStorageTextureLayout,+        texture = unusedTextureLayout,+        sampler =+          WGPUSamplerBindingLayout+            { _type = wGPUSamplerBindingType_Filtering,+              nextInChain = nullPtr+            }+      }++instance CollectBindings (NormalBinding Texture) where+  collectBinding _ n = NormalData {bType = T.pack "texture_2d<f32>", index = fromIntegral n}+  collectLayout _ n =+    WGPUBindGroupLayoutEntry+      { nextInChain = nullPtr,+        binding = fromIntegral n,+        visibility = wGPUShaderStage_Fragment .|. wGPUShaderStage_Vertex,+        bindingArraySize = 0,+        buffer = unusedBufferLayout,+        sampler = unusedSamplerLayout,+        storageTexture = unusedStorageTextureLayout,+        texture =+          WGPUTextureBindingLayout+            { sampleType = wGPUTextureSampleType_Float,+              multisampled = wgpuFalse,+              viewDimension = wGPUTextureViewDimension_2D,+              nextInChain = nullPtr+            }+      }++instance (Buffers.Bufferable a, Typeable a) => CollectBindings (UniformBinding (a Internal)) where+  collectBinding _ n =+    UniformData+      { structName = T.pack $ show $ typeRep (Proxy @a),+        structFields = Buffers.getFields @a,+        index = fromIntegral n+      }++  collectLayout _ n =+    WGPUBindGroupLayoutEntry+      { nextInChain = nullPtr,+        binding = fromIntegral n,+        visibility = wGPUShaderStage_Fragment .|. wGPUShaderStage_Vertex,+        bindingArraySize = 0,+        buffer =+          WGPUBufferBindingLayout+            { nextInChain = nullPtr,+              _type = wGPUBufferBindingType_Uniform,+              hasDynamicOffset = wgpuFalse,+              minBindingSize = fromIntegral $ Buffers.getSize @a+            },+        sampler = unusedSamplerLayout,+        storageTexture = unusedStorageTextureLayout,+        texture = unusedTextureLayout+      }++class CollectEntry a n where+  collectEntry :: a -> Nat -> WGPUBindGroupEntry++class GCollectEntries f g where+  gCollectEntries :: f p -> Nat -> ([WGPUBindGroupEntry], Nat)++instance GCollectEntries V1 V1 where+  gCollectEntries _ n = ([], n)++instance GCollectEntries U1 U1 where+  gCollectEntries _ n = ([], n)++instance (GCollectEntries f1 g1, GCollectEntries f2 g2) => GCollectEntries (f1 :*: f2) (g1 :*: g2) where+  gCollectEntries (f :*: g) n = do+    let (a, n') = gCollectEntries @f1 @g1 f n+    let (b, n'') = gCollectEntries @f2 @g2 g n'+    (a <> b, n'')++instance (CollectEntry c n) => GCollectEntries (K1 i c) (K1 i n) where+  gCollectEntries (K1 a) n = ([collectEntry @c @n a n], n + 1)++instance (GCollectEntries f n) => GCollectEntries (M1 i t f) (M1 i t n) where+  gCollectEntries (M1 a) = gCollectEntries @f @n a++instance CollectEntry TextureView (NormalBinding b) where+  collectEntry (TextureView textureView) n =+    WGPUBindGroupEntry+      { binding = fromIntegral n,+        textureView,+        size = 0,+        offset = 0,+        sampler = nullPtr,+        buffer = nullPtr,+        nextInChain = nullPtr+      }++instance CollectEntry Sampler (NormalBinding b) where+  collectEntry (Sampler sampler) n =+    WGPUBindGroupEntry+      { binding = fromIntegral n,+        textureView = nullPtr,+        size = 0,+        offset = 0,+        sampler,+        buffer = nullPtr,+        nextInChain = nullPtr+      }++instance CollectEntry (Buffer a) (UniformBinding b) where+  collectEntry Buffer {buffer, desc = BufferDescriptor {size}} n =+    WGPUBindGroupEntry+      { binding = fromIntegral n,+        textureView = nullPtr,+        size = fromIntegral size,+        offset = 0,+        sampler = nullPtr,+        buffer,+        nextInChain = nullPtr+      }++class DummyBinding a b where+  dummyBinding' :: Nat -> b++class GDummyBinding f g where+  gDummyBinding :: Nat -> (g p, Nat)++instance GDummyBinding V1 V1 where+  gDummyBinding = undefined++instance GDummyBinding U1 U1 where+  gDummyBinding n = (U1, n)++instance (GDummyBinding f1 g1, GDummyBinding f2 g2) => GDummyBinding (f1 :*: f2) (g1 :*: g2) where+  gDummyBinding n = do+    let (a, n') = gDummyBinding @f1 @g1 n+    let (b, n'') = gDummyBinding @f2 @g2 n'+    (a :*: b, n'')++instance (DummyBinding a b) => GDummyBinding (K1 i a) (K1 i b) where+  gDummyBinding n = let a = dummyBinding' @a @b n in (K1 a, n + 1)++instance (GDummyBinding a b) => GDummyBinding (M1 i t a) (M1 i t b) where+  gDummyBinding n = let (a, n') = gDummyBinding @a @b n in (M1 a, n')++instance (SingI b) => DummyBinding (NormalBinding a) (Expr b) where+  dummyBinding' n = BindingVar (fromIntegral n)++instance (Buffers.Bufferable a) => DummyBinding (UniformBinding (a Internal)) (a GPU) where+  dummyBinding' n = Buffers.dummyBuffer @a (fromIntegral n)++-- instance (KnownNat n) => Bindable (UniformBinding n Sampler) where+--   collectBindings _ = Bindings [BindingData {bType = T.pack "sampler", index = natVal (Proxy @n)}]+--   collectLayouts _ =+--     [ WGPUBindGroupLayoutEntry+--         { nextInChain = nullPtr,+--           binding = fromInteger (natVal (Proxy @n)),+--           visibility = wGPUShaderStage_Fragment,+--           bindingArraySize = 0,+--           buffer = unusedBufferLayout,+--           storageTexture = unusedStorageTextureLayout,+--           texture = unusedTextureLayout,+--           sampler =+--             WGPUSamplerBindingLayout+--               { _type = wGPUSamplerBindingType_Filtering,+--                 nextInChain = nullPtr+--               }+--         }+--     ]++--   collectEntries (UniformBinding a) = [bind a]++-- -- instance (KnownNat n, SingI b, f Internal ~ UniformBinding n a', f GPU ~ Expr b) => ToDummy f where+-- --   dummyB = BindingVar (natVal (Proxy @n))++-- instance (KnownNat n) => Bindable (UniformBinding n Texture) where+--   collectBindings _ = Bindings [BindingData {bType = T.pack "texture_2d<f32>", index = natVal (Proxy @n)}]+--   collectLayouts _ =+--     [ WGPUBindGroupLayoutEntry+--         { nextInChain = nullPtr,+--           binding = fromInteger (natVal (Proxy @n)),+--           visibility = wGPUShaderStage_Fragment,+--           bindingArraySize = 0,+--           buffer = unusedBufferLayout,+--           sampler = unusedSamplerLayout,+--           storageTexture = unusedStorageTextureLayout,+--           texture =+--             WGPUTextureBindingLayout+--               { sampleType = wGPUTextureSampleType_Float,+--                 multisampled = wgpuFalse,+--                 viewDimension = wGPUTextureViewDimension_2D,+--                 nextInChain = nullPtr+--               }+--         }+--     ]++--   collectEntries (UniformBinding a) = [bind a]++-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))++-- instance Bindable ()++-- instance (KnownNat n, SingI (Primitive a)) => Bindable (UniformBinding n (Expr (Primitive a))) where+--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (Primitive a)), index = natVal (Proxy @n)}]+--   collectLayouts _ = undefined++--   collectEntries (UniformBinding a) = [bind a]++-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))++-- instance (KnownNat n, SingI (VectorType m a)) => Bindable (UniformBinding n (Expr (VectorType m a))) where+--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (VectorType m a)), index = natVal (Proxy @n)}]+--   collectLayouts _ = undefined++--   collectEntries (UniformBinding a) = [bind a]++-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))++-- instance (KnownNat n, SingI (ArrayType m a)) => Bindable (UniformBinding n (Expr (ArrayType m a))) where+--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (ArrayType m a)), index = natVal (Proxy @n)}]+--   collectLayouts _ = undefined++--   collectEntries (UniformBinding a) = [bind a]++-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))++collectAllLayouts :: Nat -> [ErasedBinding] -> [WGPUBindGroupLayoutEntry]+collectAllLayouts _ [] = []+collectAllLayouts n (ErasedBinding _ (_ :: Proxy m) (_ :: Proxy b) : xs) =+  let (x, n') = collectLayouts n (Proxy @(b Internal))+   in x ++ collectAllLayouts n' xs++createBindLayout :: [ErasedBinding] -> RenderDevice -> IO BindLayout+createBindLayout b (RenderDevice device) = do+  let layouts = VS.fromList $ collectAllLayouts 0 b++  withWGPUString "bind group layout" $ \label -> do+    x <- VS.unsafeWith layouts $ \entries -> do+      let desc =+            WGPUBindGroupLayoutDescriptor+              { entryCount = fromIntegral $ VS.length layouts,+                entries = ConstPtr entries,+                label,+                nextInChain = nullPtr+              }+      with desc $ \desc -> wgpuDeviceCreateBindGroupLayout device (ConstPtr desc)++    pure (BindLayout x)++collectAllEntries :: Nat -> [ErasedBindingValue] -> [WGPUBindGroupEntry]+collectAllEntries _ [] = []+collectAllEntries n (ErasedBindingValue b : xs) =+  let (x, n') = collectEntries n b+   in x ++ collectAllEntries n' xs++createBindGroup :: RenderDevice -> BindLayout -> [ErasedBindingValue] -> IO (Ptr WGPUBindGroup)+createBindGroup (RenderDevice device) (BindLayout bindGroupLayout) b = do+  let entries = VS.fromList $ collectAllEntries 0 b++  withWGPUString "bind group" $ \label -> do+    VS.unsafeWith entries $ \entries' -> do+      let desc =+            WGPUBindGroupDescriptor+              { layout = bindGroupLayout,+                entryCount = fromIntegral $ VS.length entries,+                label = label,+                nextInChain = nullPtr,+                entries = ConstPtr entries'+              }++      with desc $ \desc -> wgpuDeviceCreateBindGroup device (ConstPtr desc)++-- class (Bindable link) => ConvertBindings link where+--   type CpuBind link+--   type GpuBind link+--   toLink :: CpuBind link -> link+--   mkGpu :: GpuBind link++-- bind :: a -> WGPUBindGroupEntry+-- bind = undefined++-- instance (KnownNat n) => ConvertBindings (UniformBinding (n :: Nat) Texture) where+--   type CpuBind (UniformBinding (n :: Nat) Texture) = TextureView+--   type GpuBind (UniformBinding (n :: Nat) Texture) = Expr TTexture+--   toLink (TextureView view) =+--     Uniform+--       WGPUBindGroupEntry+--         { binding = fromInteger (natVal (Proxy @n)),+--           textureView = view,+--           size = 0,+--           offset = 0,+--           sampler = nullPtr,+--           buffer = nullPtr,+--           nextInChain = nullPtr+--         }++--   mkGpu = BindingVar (natVal (Proxy @n))++-- instance (KnownNat n) => ConvertBindings (Uniform (n :: Nat) Sampler) where+--   type CpuBind (Uniform (n :: Nat) Sampler) = Sampler+--   type GpuBind (Uniform (n :: Nat) Sampler) = Expr TSampler+--   toLink (Sampler sampler) =+--     Uniform+--       WGPUBindGroupEntry+--         { binding = fromInteger (natVal (Proxy @n)),+--           textureView = nullPtr,+--           size = 0,+--           offset = 0,+--           sampler = sampler,+--           buffer = nullPtr,+--           nextInChain = nullPtr+--         }++--   mkGpu = BindingVar (natVal (Proxy @n))++-- class GMkDummy i o where+--   gMkDummy :: o++-- instance GMkDummy (K1 a b c) (K1 a b c) where
+ src/Mischief/Shader/Internal/Buffers.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Shader.Internal.Buffers where++import Data.Data+import Data.Singletons (SingI)+import Data.Text (Text)+import Data.Text qualified as T+import Foreign (Bits (shiftR), Ptr, Storable (pokeElemOff), Word32, Word8)+import GHC.Float (castFloatToWord32)+import GHC.Generics+import GHC.TypeLits (KnownNat, Nat, natVal)+import Mischief.Math.Vec qualified as Math+import Mischief.Shader.Internal.Singletons+import Mischief.Shader.Internal.State+import Mischief.Shader.Types qualified as ST++-- import Mischief.WGPU.Types.General (WGPUBufferDescriptor (..))++data Field' a = Field'++type family Field f a where+  Field GPU a = a+  Field CPU a = ToCPU a+  Field Internal a = Field' a++type family ToCPU a where+  ToCPU ST.Int = Int+  ToCPU ST.Float = Float+  ToCPU (Expr (VectorType 2 a)) = Math.V2 (ToCPU (Expr (Primitive a)))+  ToCPU (Expr (VectorType 3 a)) = Math.V3 (ToCPU (Expr (Primitive a)))+  ToCPU (Expr (VectorType 4 a)) = Math.V4 (ToCPU (Expr (Primitive a)))+  ToCPU (Expr (MatrixType 2 n)) = Math.V2 (ToCPU (Expr (VectorType n TFloat)))+  ToCPU (Expr (MatrixType 3 n)) = Math.V3 (ToCPU (Expr (VectorType n TFloat)))+  ToCPU (Expr (MatrixType 4 n)) = Math.V4 (ToCPU (Expr (VectorType n TFloat)))++type family AlignmentOf a where+  AlignmentOf ST.Int = 4+  AlignmentOf ST.Float = 4+  AlignmentOf (Expr (VectorType 2 a)) = 8+  AlignmentOf (Expr (VectorType 3 a)) = 16+  AlignmentOf (Expr (VectorType 4 a)) = 16+  AlignmentOf (Expr (MatrixType n 2)) = 8+  AlignmentOf (Expr (MatrixType n m)) = 16++type family SizeOf a where+  SizeOf ST.Int = 4+  SizeOf ST.Float = 4+  SizeOf (Expr (VectorType 2 a)) = 8+  SizeOf (Expr (VectorType 3 a)) = 12+  SizeOf (Expr (VectorType 4 a)) = 16+  SizeOf (ST.Mat 2 2) = 16+  SizeOf (ST.Mat 3 2) = 24+  SizeOf (ST.Mat 4 2) = 32+  SizeOf (ST.Mat 3 3) = 48+  SizeOf (ST.Mat 4 3) = 64+  SizeOf (ST.Mat 2 4) = 32+  SizeOf (ST.Mat 3 4) = 48+  SizeOf (ST.Mat 4 4) = 64++newtype Size = Size Nat deriving newtype (Show, Num, Eq, Ord)++newtype Alignment = Alignment Nat deriving newtype (Show, Num, Eq, Ord)++newtype Offset = Offset Nat deriving newtype (Show, Num, Eq, Ord)++newtype BufferStruct = BufferStruct [(Text, Text)]++class Bufferable a where+  dummyBuffer :: Integer -> a GPU+  default dummyBuffer :: (Generic (a GPU), GDummyBuffer (Rep (a GPU))) => Integer -> a GPU+  dummyBuffer i =+    let (x, _) = gDummyBuffer @(Rep (a GPU)) i 0+     in to x++  getFields :: [(Text, Text)]+  default getFields :: (GGetFields (Rep (a GPU))) => [(Text, Text)]+  getFields =+    let (t, Offset offset) = gGetFields @(Rep (a GPU)) 0+        t' = roundTo16Pad offset+     in t ++ t'++  getSize :: Int+  default getSize :: (GGetFields (Rep (a GPU))) => Int+  getSize =+    let Offset offset = snd $ gGetFields @(Rep (a GPU)) 0+     in fromIntegral $ roundTo16 offset++  putBytes :: a CPU -> Ptr Word8 -> IO Int+  default putBytes :: (GGetBytes (Rep (a CPU)) (Rep (a GPU)), Generic (a CPU)) => a CPU -> Ptr Word8 -> IO Int+  putBytes a ptr = do+    Offset x <- gGetBytes @(Rep (a CPU)) @(Rep (a GPU)) (from a) ptr 0+    x' <- roundTo16Bytes ptr x+    pure $ fromIntegral x'++roundTo16 :: Nat -> Nat+roundTo16 x | x `mod` 16 == 0 = x+roundTo16 x = roundTo16 (x + 4)++roundTo16Pad :: Nat -> [(Text, Text)]+roundTo16Pad x | x `mod` 16 == 0 = []+roundTo16Pad x = ("p" <> T.pack (show x), "f32") : roundTo16Pad (x + 4)++roundTo16Bytes :: Ptr Word8 -> Nat -> IO Nat+roundTo16Bytes _ x | x `mod` 16 == 0 = pure x+roundTo16Bytes ptr x = do+  pokeElemOff ptr (fromIntegral x) 0+  pokeElemOff ptr (fromIntegral x + 1) 0+  pokeElemOff ptr (fromIntegral x + 2) 0+  pokeElemOff ptr (fromIntegral x + 3) 0+  roundTo16Bytes ptr (x + 4)++addPadding :: Offset -> Alignment -> [(Text, Text)]+addPadding (Offset x) (Alignment y) | x `mod` y == 0 = []+addPadding x y = ("p" <> T.pack (show x), "f32") : addPadding (x + 4) y++addPaddingBytes :: Offset -> Alignment -> Ptr Word8 -> IO Offset+addPaddingBytes (Offset x) (Alignment y) _ | x `mod` y == 0 = pure (Offset x)+addPaddingBytes (Offset x) y ptr = do+  pokeElemOff ptr (fromIntegral x + 0) 0+  pokeElemOff ptr (fromIntegral x + 1) 0+  pokeElemOff ptr (fromIntegral x + 2) 0+  pokeElemOff ptr (fromIntegral x + 3) 0+  addPaddingBytes (Offset $ x + 4) y ptr++class GGetFields f where+  gGetFields :: Offset -> ([(Text, Text)], Offset)++instance GGetFields V1 where+  gGetFields _ = undefined++instance GGetFields U1 where+  gGetFields _ = ([], 0)++instance (GGetFields f, GGetFields g) => GGetFields (f :*: g) where+  gGetFields offset =+    let (t, offset') = gGetFields @f offset+        (t2, offset'') = gGetFields @g $ offset'+     in (t <> t2, offset'')++instance {-# OVERLAPPING #-} (SingI a, KnownNat size, KnownNat alignment, SizeOf (Expr a) ~ size, AlignmentOf (Expr a) ~ alignment) => GGetFields (S1 u (K1 i (Expr a))) where+  gGetFields (Offset offset) =+    let alignment = fromIntegral $ natVal (Proxy @alignment)+        size = fromIntegral $ natVal (Proxy @size)+        t = addPadding (Offset offset) (Alignment alignment)+     in (t <> [("q" <> T.pack (show $ offset + fromIntegral (length t) * 4), typeToWGSL (undefined :: Expr a))], Offset $ offset + size + fromIntegral (length t) * 4)++instance (GGetFields (Rep f)) => GGetFields (S1 a (K1 x f)) where+  gGetFields = gGetFields @(Rep f)++instance (GGetFields c) => GGetFields (C1 i c) where+  gGetFields = gGetFields @c++instance (GGetFields f) => GGetFields (D1 a f) where+  gGetFields = gGetFields @f++class GetBytes a where+  getBytes :: ToCPU a -> [Word8]++class GGetBytes f g where+  gGetBytes :: f p -> Ptr Word8 -> Offset -> IO Offset++instance GGetBytes V1 V1 where+  gGetBytes _ _ _ = undefined++instance GGetBytes U1 U1 where+  gGetBytes _ _ _ = pure 0++instance (GGetBytes f1 g1, GGetBytes f2 g2) => GGetBytes (f1 :*: f2) (g1 :*: g2) where+  gGetBytes (a :*: b) ptr offset = do+    offset' <- gGetBytes @f1 @g1 a ptr offset+    gGetBytes @f2 @g2 b ptr offset'++instance {-# OVERLAPPING #-} (GetBytes (Expr b), KnownNat alignment, SizeOf (Expr b) ~ size, AlignmentOf (Expr b) ~ alignment, a ~ ToCPU (Expr b)) => GGetBytes (S1 u (K1 i a)) (S1 u (K1 i (Expr b))) where+  gGetBytes (M1 (K1 a)) ptr offset = do+    let alignment = fromIntegral $ natVal (Proxy @alignment)+    offset' <- addPaddingBytes offset alignment ptr+    let bytes = getBytes @(Expr b) a+    addBytes bytes ptr offset'++addBytes :: [Word8] -> Ptr Word8 -> Offset -> IO Offset+addBytes [] _ x = pure x+addBytes (w : ws) ptr (Offset x) = do+  pokeElemOff ptr (fromIntegral x) w+  addBytes ws ptr (Offset $ x + 1)++-- (t <> [("var", typeToWGSL (undefined :: Expr a))], Offset $ offset + size + fromIntegral (length t) * 4)++instance (GGetBytes (Rep f) (Rep g), Generic f) => GGetBytes (S1 a (K1 x f)) (S1 a' (K1 x' g)) where+  gGetBytes (M1 (K1 a)) = gGetBytes @(Rep f) @(Rep g) (from a)++instance (GGetBytes f g) => GGetBytes (C1 i f) (C1 i' g) where+  gGetBytes (M1 a) = gGetBytes @f @g a++instance (GGetBytes f g) => GGetBytes (D1 a f) (D1 a' g) where+  gGetBytes (M1 a) = gGetBytes @f @g a++word32ToWords8 :: Word32 -> [Word8]+-- word32ToWords8 x = [fromIntegral (x `shiftR` 24), fromIntegral (x `shiftR` 16), fromIntegral (x `shiftR` 8), fromIntegral x]+word32ToWords8 x = [fromIntegral x, fromIntegral (x `shiftR` 8), fromIntegral (x `shiftR` 16), fromIntegral (x `shiftR` 24)]++instance GetBytes ST.Int where+  getBytes a = word32ToWords8 (fromIntegral a)++instance GetBytes ST.Float where+  getBytes a = word32ToWords8 (castFloatToWord32 a)++instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 2 b)) where+  getBytes (Math.V2 a b) = getBytes @(Expr (Primitive b)) a ++ getBytes @(Expr (Primitive b)) b++instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 3 b)) where+  getBytes (Math.V3 a b c) = getBytes @(Expr (Primitive b)) a ++ getBytes @(Expr (Primitive b)) b ++ getBytes @(Expr (Primitive b)) c++instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 4 b)) where+  getBytes (Math.V4 a b c d) = getBytes @(Expr (Primitive b)) a ++ getBytes @(Expr (Primitive b)) b ++ getBytes @(Expr (Primitive b)) c ++ getBytes @(Expr (Primitive b)) d++instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 2 a)) ~ Math.V2 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 2 a)) where+  getBytes (Math.V2 a b) = getBytes @(Expr (VectorType a TFloat)) a ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) b ++ matFillerBytes @a++instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 3 a)) ~ Math.V3 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 3 a)) where+  getBytes (Math.V3 a b c) = getBytes @(Expr (VectorType a TFloat)) a ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) b ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) c ++ matFillerBytes @a++instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 4 a)) ~ Math.V4 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 4 a)) where+  getBytes (Math.V4 a b c d) = getBytes @(Expr (VectorType a TFloat)) a ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) b ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) c ++ matFillerBytes @a ++ getBytes @(Expr (VectorType a TFloat)) d ++ matFillerBytes @a++class MatFillerBytes (n :: Nat) where+  matFillerBytes :: [Word8]++instance MatFillerBytes 2 where+  matFillerBytes = []++instance MatFillerBytes 3 where+  matFillerBytes = [0, 0, 0, 0]++instance MatFillerBytes 4 where+  matFillerBytes = []++class GDummyBuffer f where+  gDummyBuffer :: Integer -> Offset -> (f p, Offset)++instance GDummyBuffer V1 where+  gDummyBuffer = undefined++instance GDummyBuffer U1 where+  gDummyBuffer _ _ = (U1, 0)++instance (GDummyBuffer f, GDummyBuffer g) => GDummyBuffer (f :*: g) where+  gDummyBuffer index offset = do+    let (f, offset') = gDummyBuffer @f index offset+    let (g, offset'') = gDummyBuffer @g index offset'+    (f :*: g, offset'')++instance (GDummyBuffer f) => GDummyBuffer (D1 (MetaData s a b c) f) where+  gDummyBuffer index offset = do+    let (f, offset') = gDummyBuffer @f index offset+    (M1 f, offset')++instance {-# OVERLAPPING #-} (KnownNat size, KnownNat alignment, SizeOf (Expr a) ~ size, AlignmentOf (Expr a) ~ alignment) => GDummyBuffer (S1 b (K1 x (Expr a))) where+  gDummyBuffer index offset = do+    let alignment = fromIntegral $ natVal (Proxy @alignment)+    let size = natVal (Proxy @size)+    let t = addPadding offset (Alignment alignment)+    let offset' = offset + Offset (fromIntegral $ length t) * 4+    (M1 $ K1 $ VarCustom $ "b" <> T.pack (show index) <> ".q" <> T.pack (show offset'), offset' + Offset (fromIntegral size))++instance {-# OVERLAPPABLE #-} (GDummyBuffer (Rep f), Generic f) => GDummyBuffer (S1 b (K1 x f)) where+  gDummyBuffer x y =+    let (a, o) = gDummyBuffer @(Rep f) x y+     in (M1 $ K1 $ to a, o)++instance (GDummyBuffer c) => GDummyBuffer (C1 i c) where+  gDummyBuffer x y =+    let (a, o) = gDummyBuffer @c x y+     in (M1 a, o)
+ src/Mischief/Shader/Internal/Params.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}++module Mischief.Shader.Internal.Params where++import Data.Data+import Data.Default+import Data.Singletons (SingI)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics+import GHC.Records+import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)+import Mischief.Shader.Internal.Bindings+import Mischief.Shader.Internal.Singletons+import Mischief.Shader.Internal.State++data BuiltInParam (n :: Symbol) b = BuiltInParam++data LocationParam (n :: Nat) b = LocationParam++data ParamDefinition = StructParam Text Params | AnonParam Text Text++type family BuiltIn a n b where+  BuiltIn Internal n b = BuiltInParam n b+  BuiltIn GPU n (Expr b) = Expr b++type family Location a n b where+  Location Internal n b = LocationParam n b+  Location GPU n (Expr b) = Expr b++-- data BuiltIn (name :: Symbol) a where+--   BuiltIn :: forall a name. (Expr a) -> BuiltIn name (Expr a)++-- data Location (n :: Nat) a where+--   Location :: forall a n. (Expr a) -> Location n (Expr a)++data ParamKind = LocKind Integer | BuiltInKind Text deriving (Show)++data ParamData = ParamData+  { pType :: Text,+    index :: ParamKind+  }+  deriving (Show)++newtype Params = Params [ParamData] deriving newtype (Semigroup, Show)++data Value where+  Value :: Expr a -> Value++newtype Values = Values [Value] deriving newtype (Semigroup)++class (Typeable (a GPU)) => ShaderParam a where+  collectParams :: Params+  default collectParams :: (GCollectParams (Rep (a Internal))) => Params+  collectParams = gCollectParams @(Rep (a Internal))++  paramDefinition :: ParamDefinition+  paramDefinition = StructParam (T.map (\case ' ' -> '_'; n -> n) $ T.pack $ show (typeRep (Proxy @(a GPU)))) (collectParams @a)++  -- collectValues :: a -> Values+  -- default collectValues :: (Generic a, ShaderParam' (Rep (a ))) => a -> Values+  -- collectValues a = collectValues' (from a)++  dummyParam :: a GPU+  default dummyParam :: (Generic (a GPU), GDummyParam (Rep (a Internal)) (Rep (a GPU))) => a GPU+  dummyParam = to (gDummyParam @(Rep (a Internal)) @(Rep (a GPU)))++  collectValues :: a GPU -> Values+  default collectValues :: (Generic (a GPU), GCollectValues (Rep (a GPU))) => a GPU -> Values+  collectValues a = gCollectValues (from a)++class CollectParam a where+  collectParam :: ParamData+  getName' :: Text+  getType' :: Text -> Text++class GCollectParams f where+  gCollectParams :: Params++instance GCollectParams V1 where+  gCollectParams = undefined++instance GCollectParams U1 where+  gCollectParams = Params []++instance (GCollectParams f, GCollectParams g) => GCollectParams (f :*: g) where+  gCollectParams = gCollectParams @f <> gCollectParams @g++instance (CollectParam c) => GCollectParams (K1 i c) where+  gCollectParams = Params [collectParam @c]++instance (GCollectParams f) => GCollectParams (M1 i t f) where+  gCollectParams = gCollectParams @f++instance (KnownSymbol s, SingI (Primitive a)) => CollectParam (BuiltInParam s (Expr (Primitive a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (Primitive a)), index = BuiltInKind $ T.pack $ symbolVal (Proxy @s)}+  getName' = ""++  getType' "" = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> typeToWGSL (undefined :: Expr (Primitive a))+  getType' n = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (Primitive a))++instance (KnownSymbol s, SingI (VectorType m a)) => CollectParam (BuiltInParam s (Expr (VectorType m a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (VectorType m a)), index = BuiltInKind $ T.pack $ symbolVal (Proxy @s)}+  getName' = ""+  getType' "" = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> typeToWGSL (undefined :: Expr (VectorType m a))+  getType' n = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (VectorType m a))++instance (KnownSymbol s, SingI (ArrayType a)) => CollectParam (BuiltInParam s (Expr (ArrayType a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (ArrayType a)), index = BuiltInKind $ T.pack $ symbolVal (Proxy @s)}+  getName' = ""+  getType' "" = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> typeToWGSL (undefined :: Expr (ArrayType a))+  getType' n = "@builtin(" <> T.pack (symbolVal (Proxy @s)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (ArrayType a))++instance (KnownNat n, SingI (Primitive a)) => CollectParam (LocationParam n (Expr (Primitive a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (Primitive a)), index = LocKind $ fromInteger $ natVal (Proxy @n)}+  getName' = ""+  getType' "" = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> typeToWGSL (undefined :: Expr (Primitive a))+  getType' n = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (Primitive a))++instance (KnownNat n, SingI (VectorType m a)) => CollectParam (LocationParam n (Expr (VectorType m a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (VectorType m a)), index = LocKind $ fromInteger $ natVal (Proxy @n)}+  getName' = ""+  getType' "" = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> typeToWGSL (undefined :: Expr (VectorType m a))+  getType' n = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (VectorType m a))++instance (KnownNat n, SingI (ArrayType a)) => CollectParam (LocationParam n (Expr (ArrayType a))) where+  collectParam = ParamData {pType = typeToWGSL (undefined :: Expr (ArrayType a)), index = LocKind $ fromInteger $ natVal (Proxy @n)}+  getName' = ""+  getType' "" = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> typeToWGSL (undefined :: Expr (ArrayType a))+  getType' n = "@location(" <> T.pack (show $ natVal (Proxy @n)) <> ") " <> n <> ": " <> typeToWGSL (undefined :: Expr (ArrayType a))++class DummyParam a b where+  dummyParam' :: b++class GDummyParam f g where+  gDummyParam :: g p++instance GDummyParam V1 V1 where+  gDummyParam = undefined++instance GDummyParam U1 U1 where+  gDummyParam = U1++instance (GDummyParam f1 g1, GDummyParam f2 g2) => GDummyParam (f1 :*: f2) (g1 :*: g2) where+  gDummyParam = gDummyParam @f1 @g1 :*: gDummyParam @f2 @g2++instance (DummyParam a b) => GDummyParam (K1 i a) (K1 i b) where+  gDummyParam = K1 $ dummyParam' @a @b++instance (GDummyParam a b) => GDummyParam (M1 i t a) (M1 i' t' b) where+  gDummyParam = M1 $ gDummyParam @a @b++instance (KnownSymbol n, SingI b) => DummyParam (BuiltInParam n a) (Expr b) where+  dummyParam' = BuiltInVar (T.pack $ symbolVal $ Proxy @n)++instance (KnownNat n, SingI b) => DummyParam (LocationParam n a) (Expr b) where+  dummyParam' = LocationVar (fromInteger $ natVal $ Proxy @n)++class GCollectValues f where+  gCollectValues :: f p -> Values++instance GCollectValues V1 where+  gCollectValues _ = undefined++instance GCollectValues U1 where+  gCollectValues _ = Values []++instance (GCollectValues f, GCollectValues g) => GCollectValues (f :*: g) where+  gCollectValues (f :*: g) = gCollectValues f <> gCollectValues g++instance GCollectValues (K1 i (Expr b)) where+  gCollectValues (K1 c) = Values [Value c]++instance (GCollectValues f) => GCollectValues (M1 i t f) where+  gCollectValues (M1 f) = gCollectValues f++-- instance (KnownNat n, Typeable (Location' n (Expr a) GPU)) => ShaderParam (Location' n (Expr a)) where+--   collectParams = undefined+--   getName = undefined+--   getType = undefined+--   dummyParam = undefined+--   collectValues a = Values [a]++newtype LocInternal n a f = Loc (Location f n a) deriving stock (Generic)++instance+  ( SingI b,+    Typeable a,+    Location GPU n a ~ Expr b,+    KnownNat n,+    CollectParam (LocationParam n a),+    DummyParam+      (LocationParam n a)+      (Location GPU n a)+  ) =>+  ShaderParam (LocInternal n a)+  where+  paramDefinition = AnonParam ("@location(" <> T.pack (show $ natVal $ Proxy @n) <> ")") (typeToWGSL (undefined :: Expr b))++  dummyParam = Loc $ VarCustom @b "input"++type Loc n a = LocInternal n a GPU++newtype BInInternal n a f = BIn (BuiltIn f n a) deriving stock (Generic)++instance+  ( SingI b,+    Typeable a,+    BuiltIn GPU n a ~ Expr b,+    KnownSymbol n,+    CollectParam (BuiltInParam n a),+    DummyParam+      (BuiltInParam n a)+      (BuiltIn GPU n a)+  ) =>+  ShaderParam (BInInternal n a)+  where+  paramDefinition = AnonParam ("@builtin(" <> T.pack (symbolVal $ Proxy @n) <> ")") (typeToWGSL (undefined :: Expr b))+  dummyParam = BIn $ VarCustom @b "input"++type BIn n a = BInInternal n a GPU
+ src/Mischief/Shader/Internal/Singletons.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoCUSKs #-}+{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE NoStarIsType #-}++module Mischief.Shader.Internal.Singletons where++import Data.Singletons.Base.CustomStar+import GHC.TypeLits+import Prelude (Eq)++data PrimitiveTypes = TInt | TFloat | TUInt deriving (Eq)++data Types where+  Primitive :: PrimitiveTypes -> Types+  ArrayType :: Types -> Types+  VectorType :: Nat -> PrimitiveTypes -> Types+  MatrixType :: Nat -> Nat -> Types+  TTexture :: Types+  TSampler :: Types+  TVoid :: Types+  TBool :: Types+  MType :: Types -> Types+  deriving (Eq)++genSingletons [''PrimitiveTypes, ''Types]
+ src/Mischief/Shader/Internal/State.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeAbstractions #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++module Mischief.Shader.Internal.State where++import Control.Monad.State+import Data.Data hiding (cast)+import Data.Map (Map)+import Data.Singletons (SingI, demote)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.TypeLits (Nat, type (+))+import Mischief.Shader.Internal.Singletons+import Unsafe.Coerce (unsafeCoerce)+import Prelude hiding (cos, sin)++data ErasedValue where+  ErasedValue :: a -> ErasedValue++data ShaderState = ShaderState+  { counter :: VarIndex,+    ast :: Stmt,+    dict :: Map TypeRep ErasedValue+  }++newtype VarIndex = VarIndex Integer+  deriving newtype (Show, Num)++nameIndex :: VarIndex -> Text+nameIndex i = "v" <> T.pack (show i)++data Stmt where+  Concat :: Stmt -> Stmt -> Stmt+  Let :: VarIndex -> Expr a -> Stmt+  Return :: Expr a -> Stmt+  Debug :: Text -> Stmt+  Empty :: Stmt++data CustomType a = CustomType++instance Eq (CustomType a) where+  _ == _ = False++data Expr (a :: Types) where+  Function :: Text -> [Param] -> Expr a+  Add :: (SingI a) => Expr a -> Expr a -> Expr a+  Sub :: (SingI a) => Expr a -> Expr a -> Expr a+  Mult :: (SingI a) => Expr a -> Expr a -> Expr a+  Div :: (SingI a) => Expr a -> Expr a -> Expr a+  Neg :: (SingI a) => Expr a -> Expr a+  Abs :: (SingI a) => Expr a -> Expr a+  Signum :: (SingI a) => Expr a -> Expr a+  Cast :: (SingI a, SingI b) => Proxy b -> Expr a -> Expr b+  CastVec :: (SingI (VectorType n a), SingI (VectorType n b)) => Proxy (VectorType n b) -> Expr (VectorType n a) -> Expr (VectorType n b)+  ConstantInt :: Int -> Expr (Primitive TInt)+  ConstantFloat :: Float -> Expr (Primitive TFloat)+  ConstantUInt :: Int -> Expr (Primitive TUInt)+  ConstantArray :: forall (a' :: Types). (SingI a') => (Proxy a') -> [Expr a'] -> Expr (ArrayType a')+  ConstantVec :: forall (n :: Nat) (a' :: PrimitiveTypes). (PrintVecElements n a', SingI (VectorType n a')) => Proxy (VectorType n a') -> VecInit n a' -> Expr (VectorType n a')+  ConstantMat :: forall (n :: Nat) (m :: Nat). (PrintMatElements n m, SingI (MatrixType n m)) => Proxy (MatrixType n m) -> MatInit n m -> Expr (MatrixType n m)+  AccessField :: (SingI a) => Expr a -> Text -> Expr b+  Index :: (SingI (ArrayType a)) => Expr (ArrayType a) -> Expr (Primitive TUInt) -> Expr a+  Var :: (SingI a) => VarIndex -> Expr a+  BindingVar :: (SingI a) => Integer -> Expr a+  BuiltInVar :: (SingI a) => Text -> Expr a+  StructInit :: Text -> [Text] -> Expr a+  LocationVar :: (SingI a) => Integer -> Expr a+  VarCustom :: Text -> Expr a+  CustomOperator :: Text -> Expr a -> Expr b -> Expr c+  Void :: (SingI a) => Expr a+  AppendVecs :: forall (n :: Nat) (m :: Nat) a. (SingI a, PrintVecElements (n + m) a, SingI (VectorType (n + m) a)) => Proxy (VectorType (n + m) a) -> Expr (VectorType n a) -> Expr (VectorType m a) -> Expr (VectorType (n + m) a)+  ExtendVec :: forall (n :: Nat) a. (SingI a, PrintVecElements (n + 1) a, SingI (VectorType (n + 1) a)) => Proxy (VectorType (n + 1) a) -> Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType (n + 1) a)+  ConstantBool :: Bool -> Expr TBool+  If :: Expr TBool -> Expr a -> Expr a -> Expr a++data Param where+  Param :: (SingI a) => Expr a -> Param++type family VectorOrSingleOf a where+  VectorOrSingleOf (VectorType n a) = a+  VectorOrSingleOf (Primitive a) = a++instance (SingI a) => Num (Expr (Primitive a)) where+  (+) = Add+  (*) = Mult+  abs = Abs+  signum = Signum+  fromInteger i =+    let t = demote @a+     in case t of+          TInt -> unsafeCoerce $ ConstantInt (fromInteger i)+          TFloat -> unsafeCoerce $ ConstantFloat (fromInteger i)+          TUInt -> unsafeCoerce $ ConstantUInt (fromInteger i)+  negate = Neg++instance Fractional (Expr (Primitive TFloat)) where+  fromRational = ConstantFloat . fromRational+  recip = Div 1+  (/) = Div++type family VecInit (n :: Nat) (a :: PrimitiveTypes) where+  VecInit 2 a = (Expr (Primitive a), Expr (Primitive a))+  VecInit 3 a = (Expr (Primitive a), Expr (Primitive a), Expr (Primitive a))+  VecInit 4 a = (Expr (Primitive a), Expr (Primitive a), Expr (Primitive a), Expr (Primitive a))++class PrintVecElements (n :: Nat) (a :: PrimitiveTypes) where+  printVecElements :: VecInit n a -> Text++instance PrintVecElements 2 a where+  printVecElements (a, b) = exprToWGSL a <> ", " <> exprToWGSL b++instance PrintVecElements 3 a where+  printVecElements (a, b, c) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c++instance PrintVecElements 4 a where+  printVecElements (a, b, c, d) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c <> ", " <> exprToWGSL d++type family ArrayInit (n :: Nat) a where+  ArrayInit 2 a = (Expr a, Expr a)+  ArrayInit 3 a = (Expr a, Expr a, Expr a)+  ArrayInit 4 a = (Expr a, Expr a, Expr a, Expr a)+  ArrayInit 5 a = (Expr a, Expr a, Expr a, Expr a, Expr a)+  ArrayInit 6 a = (Expr a, Expr a, Expr a, Expr a, Expr a, Expr a)++class PrintArrayElements (n :: Nat) (a :: Types) where+  printArrayElements :: ArrayInit n a -> Text++instance PrintArrayElements 2 a where+  printArrayElements (a, b) = exprToWGSL a <> ", " <> exprToWGSL b++instance PrintArrayElements 3 a where+  printArrayElements (a, b, c) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c++instance PrintArrayElements 4 a where+  printArrayElements (a, b, c, d) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c <> ", " <> exprToWGSL d++instance PrintArrayElements 5 a where+  printArrayElements (a, b, c, d, e) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c <> ", " <> exprToWGSL d <> ", " <> exprToWGSL e++instance PrintArrayElements 6 a where+  printArrayElements (a, b, c, d, e, f) = exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c <> ", " <> exprToWGSL d <> ", " <> exprToWGSL e <> ", " <> exprToWGSL f++type family MatInit (n :: Nat) (m :: Nat) where+  MatInit 2 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat))+  MatInit 3 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat))+  MatInit 4 a = (Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat), Expr (VectorType a TFloat))++class PrintMatElements (n :: Nat) (m :: Nat) where+  printMatElements :: MatInit n m -> Text++instance PrintMatElements 2 n where+  printMatElements (a, b) =+    exprToWGSL a <> ", " <> exprToWGSL b++instance PrintMatElements 3 n where+  printMatElements (a, b, c) =+    exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c++instance PrintMatElements 4 n where+  printMatElements (a, b, c, d) =+    exprToWGSL a <> ", " <> exprToWGSL b <> ", " <> exprToWGSL c <> ", " <> exprToWGSL d++showArgs :: [Param] -> Text+showArgs [] = ""+showArgs [Param x] = exprToWGSL x+showArgs ((Param x) : xs) = exprToWGSL x <> ", " <> showArgs xs++exprToWGSL :: Expr a -> Text+exprToWGSL (Function t x) = t <> "(" <> showArgs x <> ")"+exprToWGSL (Add a b) = "(" <> exprToWGSL a <> " + " <> exprToWGSL b <> ")"+exprToWGSL (Mult a b) = "(" <> exprToWGSL a <> " * " <> exprToWGSL b <> ")"+exprToWGSL (Sub a b) = "(" <> exprToWGSL a <> " - " <> exprToWGSL b <> ")"+exprToWGSL (Div a b) = "(" <> exprToWGSL a <> " / " <> exprToWGSL b <> ")"+exprToWGSL (Neg a) = "(-" <> exprToWGSL a <> ")"+exprToWGSL (Abs a) = exprToWGSL (Function "abs" [Param a])+exprToWGSL (Signum a) = exprToWGSL (Function "sign" [Param a])+exprToWGSL (Cast (_ :: Proxy b) (a :: Expr a)) =+  let aType = demote @a+      bType = demote @b+   in if aType == bType+        then exprToWGSL a+        else case bType of+          Primitive TInt -> "i32(" <> exprToWGSL a <> ")"+          Primitive TFloat -> "f32(" <> exprToWGSL a <> ")"+          Primitive TUInt -> "u32(" <> exprToWGSL a <> ")"+          _ -> undefined+exprToWGSL (CastVec (_ :: Proxy b) (a :: Expr a)) =+  let aType = demote @a+      bType = demote @b+   in if aType == bType+        then exprToWGSL a+        else case bType of+          VectorType 2 TInt -> "vec2<i32>(" <> exprToWGSL a <> ")"+          VectorType 2 TFloat -> "vec2<f32>(" <> exprToWGSL a <> ")"+          VectorType 2 TUInt -> "vec2<u32>(" <> exprToWGSL a <> ")"+          VectorType 3 TInt -> "vec3<i32>(" <> exprToWGSL a <> ")"+          VectorType 3 TFloat -> "vec3<f32>(" <> exprToWGSL a <> ")"+          VectorType 3 TUInt -> "vec3<u32>(" <> exprToWGSL a <> ")"+          VectorType 4 TInt -> "vec4<i32>(" <> exprToWGSL a <> ")"+          VectorType 4 TFloat -> "vec4<f32>(" <> exprToWGSL a <> ")"+          VectorType 4 TUInt -> "vec4<u32>(" <> exprToWGSL a <> ")"+          _ -> undefined+exprToWGSL (ConstantArray (_ :: Proxy a) x) =+  let element = typeToWGSL' (demote @a)+   in "array<" <> element <> ", " <> T.show (length x) <> ">(" <> T.intercalate ", " (map exprToWGSL x) <> ")"+exprToWGSL (ConstantVec @n @a' (_ :: Proxy a) x) =+  let elements = printVecElements @n @a' x+   in case demote @a of+        VectorType 2 TInt -> "vec2<i32>(" <> elements <> ")"+        VectorType 2 TFloat -> "vec2<f32>(" <> elements <> ")"+        VectorType 2 TUInt -> "vec2<u32>(" <> elements <> ")"+        VectorType 3 TInt -> "vec3<i32>(" <> elements <> ")"+        VectorType 3 TFloat -> "vec3<f32>(" <> elements <> ")"+        VectorType 3 TUInt -> "vec3<u32>(" <> elements <> ")"+        VectorType 4 TInt -> "vec4<i32>(" <> elements <> ")"+        VectorType 4 TFloat -> "vec4<f32>(" <> elements <> ")"+        VectorType 4 TUInt -> "vec4<u32>(" <> elements <> ")"+        _ -> undefined+exprToWGSL (ConstantMat @n @m (_ :: Proxy a) x) =+  let elements = printMatElements @n @m x+   in case demote @a of+        MatrixType 2 2 -> "mat2x2<f32>(" <> elements <> ")"+        MatrixType 3 2 -> "mat2x3<f32>(" <> elements <> ")"+        MatrixType 4 2 -> "mat2x4<f32>(" <> elements <> ")"+        MatrixType 2 3 -> "mat3x2<f32>(" <> elements <> ")"+        MatrixType 3 3 -> "mat3x3<f32>(" <> elements <> ")"+        MatrixType 4 3 -> "mat3x4<f32>(" <> elements <> ")"+        MatrixType 2 4 -> "mat4x2<f32>(" <> elements <> ")"+        MatrixType 3 4 -> "mat4x3<f32>(" <> elements <> ")"+        MatrixType 4 4 -> "mat4x4<f32>(" <> elements <> ")"+        _ -> undefined+exprToWGSL (ConstantInt x) = T.pack $ show x <> "i"+exprToWGSL (ConstantFloat x) = T.pack $ show x <> "f"+exprToWGSL (ConstantUInt x) = T.pack $ show x <> "u"+exprToWGSL (Var x) = nameIndex x+exprToWGSL (BindingVar x) = "b" <> T.pack (show x)+exprToWGSL Void = ""+exprToWGSL (AccessField x f) = exprToWGSL x <> "." <> f+exprToWGSL (Index a i) = exprToWGSL a <> "[" <> exprToWGSL i <> "]"+exprToWGSL (BuiltInVar x) = "input." <> x+exprToWGSL (LocationVar x) = "input.l" <> T.pack (show x)+exprToWGSL (StructInit "" [p]) = p+exprToWGSL (StructInit name params) = name <> "(" <> T.intercalate "," params <> ")"+exprToWGSL (CustomOperator op a b) = "(" <> exprToWGSL a <> " " <> op <> " " <> exprToWGSL b <> ")"+exprToWGSL (VarCustom t) = t+exprToWGSL (AppendVecs (_ :: Proxy v) a b) = case demote @v of+  VectorType 2 TInt -> "vec2<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 2 TFloat -> "vec2<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 2 TUInt -> "vec2<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TInt -> "vec3<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TFloat -> "vec3<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TUInt -> "vec3<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TInt -> "vec4<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TFloat -> "vec4<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TUInt -> "vec4<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  _ -> undefined+exprToWGSL (ExtendVec (_ :: Proxy v) a b) = case demote @v of+  VectorType 2 TInt -> "vec2<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 2 TFloat -> "vec2<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 2 TUInt -> "vec2<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TInt -> "vec3<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TFloat -> "vec3<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 3 TUInt -> "vec3<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TInt -> "vec4<i32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TFloat -> "vec4<f32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  VectorType 4 TUInt -> "vec4<u32>(" <> exprToWGSL a <> "," <> exprToWGSL b <> ")"+  _ -> undefined+exprToWGSL (ConstantBool b) = if b then "true" else "false"+exprToWGSL (If bool a b) = "if " <> exprToWGSL bool <> " {" <> exprToWGSL a <> "} else {" <> exprToWGSL b <> "}"++stmtToWGSL :: Stmt -> Text+stmtToWGSL Empty = ""+stmtToWGSL (Concat Empty a) = stmtToWGSL a+stmtToWGSL (Concat a b) = stmtToWGSL a <> "\n" <> stmtToWGSL b+stmtToWGSL (Let a b) = "  let " <> nameIndex a <> " = " <> exprToWGSL b <> ";"+stmtToWGSL (Return a) = "  return " <> exprToWGSL a <> ";"+stmtToWGSL (Debug t) = "  //" <> t++-- stmtToWGSL (VLet a b) = "  var " <> nameIndex a <> " = " <> exprToWGSL b <> ";"++newtype Shader m a = Shader (State ShaderState a) deriving newtype (Functor, Applicative, Monad, MonadState ShaderState)++typeToWGSL :: forall (a :: Types). (SingI a) => Expr a -> Text+typeToWGSL _ = typeToWGSL' (demote @a)++typeToWGSL' :: Types -> Text+typeToWGSL' a = case a of+  Primitive TInt -> "i32"+  Primitive TFloat -> "f32"+  Primitive TUInt -> "u32"+  -- ArrayType n t -> "array<" <> typeToWGSL' t <> ", " <> T.pack (show n) <> ">"+  VectorType 2 TFloat -> "vec2<f32>"+  VectorType 2 TInt -> "vec2<i32>"+  VectorType 2 TUInt -> "vec2<u32>"+  VectorType 3 TFloat -> "vec3<f32>"+  VectorType 3 TInt -> "vec3<i32>"+  VectorType 3 TUInt -> "vec3<u32>"+  VectorType 4 TFloat -> "vec4<f32>"+  VectorType 4 TInt -> "vec4<i32>"+  VectorType 4 TUInt -> "vec4<u32>"+  MatrixType 2 2 -> "mat2x2<f32>"+  MatrixType 2 3 -> "mat2x3<f32>"+  MatrixType 2 4 -> "mat2x4<f32>"+  MatrixType 3 2 -> "mat3x2<f32>"+  MatrixType 3 3 -> "mat3x3<f32>"+  MatrixType 3 4 -> "mat3x4<f32>"+  MatrixType 4 2 -> "mat4x2<f32>"+  MatrixType 4 3 -> "mat4x3<f32>"+  MatrixType 4 4 -> "mat4x4<f32>"+  _ -> undefined++addStmt :: Stmt -> Shader m ()+addStmt stmt = do+  state <- get+  put state {ast = Concat state.ast stmt}++newVarIndex :: Shader m VarIndex+newVarIndex = do+  ShaderState {counter, ast, dict} <- get+  put (ShaderState {counter = counter + 1, ast, dict})+  pure counter++var :: (SingI a) => Expr a -> Shader m (Expr a)+var expr = do+  index <- newVarIndex+  addStmt (Let index expr)+  pure $ Var index++comment :: Text -> Shader m ()+comment t = addStmt (Debug t)++data CPU++data GPU++data Internal
+ src/Mischief/Shader/Types.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++module Mischief.Shader.Types where++import Data.Data+import Data.List+import Data.Singletons (SingI)+import Data.Text qualified as T+import Data.Type.Ord (type (>=))+import GHC.Records (HasField (getField))+import GHC.TypeLits+import Mischief.Shader.Internal.Singletons+import Mischief.Shader.Internal.State+import Prelude (Bool (..), Char, Maybe (Just, Nothing), Show (show), String, undefined, ($), type (~))+import Prelude qualified++float :: Prelude.Float -> Float+float = ConstantFloat++int :: Prelude.Int -> Int+int = ConstantInt++uint :: Prelude.Int -> Uint+uint = ConstantUInt++f32 :: Prelude.Float -> Float+f32 = float++i32 :: Prelude.Int -> Int+i32 = int++u32 :: Prelude.Int -> Uint+u32 = uint++vec2 :: forall a. (Expr (Primitive (DesugarPrimitiveExpr a)) ~ a, SingI (DesugarPrimitiveExpr a), PrintVecElements 2 (DesugarPrimitiveExpr a)) => Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Vec 2 a+vec2 a b = ConstantVec Proxy (a, b)++vec3 :: forall a. (Expr (Primitive (DesugarPrimitiveExpr a)) ~ a, SingI (DesugarPrimitiveExpr a), PrintVecElements 3 (DesugarPrimitiveExpr a)) => Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Vec 3 a+vec3 a b c = ConstantVec Proxy (a, b, c)++vec4 :: forall a. (Expr (Primitive (DesugarPrimitiveExpr a)) ~ a, SingI (DesugarPrimitiveExpr a), PrintVecElements 4 (DesugarPrimitiveExpr a)) => Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Expr (Primitive (DesugarPrimitiveExpr a)) -> Vec 4 a+vec4 a b c d = ConstantVec Proxy (a, b, c, d)++(+:) :: (SingI a, PrintVecElements (n + 1) a, KnownNat (n + 1)) => Expr (VectorType n a) -> Expr (Primitive a) -> Expr (VectorType (n + 1) a)+(+:) = ExtendVec Proxy++(<>) :: (SingI a, PrintVecElements (n + m) a, KnownNat (n + m)) => Expr (VectorType n a) -> Expr (VectorType m a) -> Expr (VectorType (n + m) a)+(<>) = AppendVecs Proxy++array :: forall a. (SingI (DesugarExpr a)) => [Expr (DesugarExpr a)] -> Array a+array = ConstantArray (Proxy @(DesugarExpr a))++(!!) :: (SingI a) => Array (Expr a) -> Uint -> Expr a+(!!) = Index++type Boolean = Expr TBool++type Int = Expr (Primitive TInt)++type Float = Expr (Primitive TFloat)++type Uint = Expr (Primitive TUInt)++type family DesugarExpr a where+  DesugarExpr (Expr a) = a++type family DesugarPrimitiveExpr a where+  DesugarPrimitiveExpr Int = TInt+  DesugarPrimitiveExpr Float = TFloat+  DesugarPrimitiveExpr Uint = TUInt++type Array b = Expr (ArrayType (DesugarExpr b))++type Vec n a = Expr (VectorType n (DesugarPrimitiveExpr a))++type Vec2 a = Vec 2 a++type Vec3 a = Vec 3 a++type Vec4 a = Vec 4 a++type Mat n m = Expr (MatrixType n m)++mat :: forall n m. (KnownNat n, KnownNat m, PrintMatElements n m) => MatInit n m -> Mat n m+mat = ConstantMat (Proxy @(MatrixType n m))++class (SingI b, SingI a) => Cast b a where+  cast :: Expr a -> Expr b++instance (SingI (Primitive a), SingI (Primitive b)) => Cast (Primitive a) (Primitive b) where+  cast = Cast (Proxy @(Primitive a))++instance (SingI (VectorType n a), SingI (VectorType n b)) => Cast (VectorType n a) (VectorType n b) where+  cast = CastVec (Proxy @(VectorType n a))++type family Fractional a where+  Fractional Float = True+  Fractional (Expr (VectorType n a)) = Fractional (Expr (Primitive a))+  Fractional a = False++type family Algebric (a :: Types) where+  Algebric (Primitive a) = True+  Algebric (VectorType n a) = True+  Algebric a = False++type family Integral (a :: Types) where+  Integral (Primitive TInt) = True+  Integral (Primitive TUInt) = True+  Integral (VectorType n TInt) = True+  Integral (VectorType n TUInt) = True+  Integral a = False++diag :: forall n a. (n <= 4, KnownNat n, SingI a) => Expr (Primitive a) -> Expr (VectorType n a)+diag a = case eqT @2 @n of+  Just Refl -> ConstantVec (Proxy @(VectorType 2 a)) (a, a)+  Nothing -> case eqT @3 @n of+    Just Refl -> ConstantVec (Proxy @(VectorType 3 a)) (a, a, a)+    Nothing -> case eqT @4 @n of+      Just Refl -> ConstantVec (Proxy @(VectorType 4 a)) (a, a, a, a)+      Nothing -> undefined++type family SwizzleChar c n where+  SwizzleChar 'x' 1 = True+  SwizzleChar 'r' 1 = True+  SwizzleChar 'y' 2 = True+  SwizzleChar 'g' 2 = True+  SwizzleChar 'z' 3 = True+  SwizzleChar 'b' 3 = True+  SwizzleChar 'w' 4 = True+  SwizzleChar 'a' 4 = True+  SwizzleChar c 1 = False+  SwizzleChar c n = SwizzleChar c (n - 1)++type family Swizzle (s :: Symbol) (n :: Nat) :: Maybe Nat where+  Swizzle "" n = Just 0+  Swizzle s n = SwizzleRec (UnconsSymbol s) n++type family SwizzleRec (s :: Maybe (Char, Symbol)) (n :: Nat) :: Maybe Nat where+  SwizzleRec (Just '(c, s)) n = SwizzleRec' s n (SwizzleChar c n)+  SwizzleRec s n = Nothing++type family SwizzleRec' s n b where+  SwizzleRec' s n True = IncMaybe (Swizzle s n)+  SwizzleRec' s n b = Nothing++type family IncMaybe (n :: Maybe Nat) :: Maybe Nat where+  IncMaybe (Just n) = Just (n + 1)+  IncMaybe Nothing = Nothing++type family SwizzleOutput (a :: PrimitiveTypes) (n :: Nat) where+  SwizzleOutput a 1 = Primitive a+  SwizzleOutput a n = VectorType n a++instance (KnownSymbol s, KnownNat n, SingI a, Swizzle s n ~ Just m, m >= 1, m <= 4, SwizzleOutput a m ~ out) => HasField s (Expr (VectorType n a)) (Expr out) where+  getField v = AccessField v (T.pack $ map m $ symbolVal $ Proxy @s)+    where+      m 'r' = 'x'+      m 'g' = 'y'+      m 'b' = 'z'+      m 'a' = 'w'+      m a = a
+ src/Mischief/WGPU.hs view
@@ -0,0 +1,58 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Mischief.WGPU+  ( -- * What is WGPU?+    -- $whatis++    -- * Installing WGPU+    -- $installing++    -- * Possible Issues+    -- $issues+    module Mischief.WGPU.Core,+  )+where++import Mischief.WGPU.Core++-- $whatis+-- [WGPU](https://github.com/gfx-rs/wgpu) is a low-level Rust rendering API. It+-- is compatible with many rendering backends including Vulkan, Metal, D3D12, OpenGL, WebGL2 and WebGPU.+--+-- This module provides bindings for [wgpu-native](https://github.com/gfx-rs/wgpu-native/releases/tag/v29.0.1.1),+-- a C-based wrapper around WGPU.++-- $installing+-- Download the correct binary build from [here](https://github.com/gfx-rs/wgpu-native/releases/tag/v29.0.1.1) for your+-- Operating System.+--+-- Put the path to it in the @extra-lib-dirs@ of your haskell project:+--+-- @+-- extra-lib-dirs: \/path\/to\/wgpu\/lib+-- @+--+-- This is usually done in @cabal.project.local@ (since it will be different on each developer's machine) but can be put in your+-- normal @.cabal@ file too.++-- $issues+--+-- On linux you may also need to add this path to the @LD_LIBRARY_PATH@ env variable, like so:+--+-- @+-- export LD_LIBRARY_PATH=\"path\/to\/wgpu\/lib\:\$LD_LIBRARY_PATH\"+-- @+--+-- On mac, you might encounter a problem where the OS refuses to include the wgpu headers into hsc2hs. In that case, you'll need to add this into your+-- @cabal.project.local@:+--+-- @+-- package mischief-render+--   hsc2hs-options: --lflag=-Wl,-rpath,path\/to\/wgpu\/lib+-- @+--+-- And run this on the CLI:+--+-- @+-- xattr -dr com.apple.quarantine path\/to\/wgpu+-- @
+ src/Mischief/WGPU/Callbacks.hs view
@@ -0,0 +1,39 @@+module Mischief.WGPU.Callbacks where++import Data.Primitive+import Foreign (FunPtr, Ptr)+import Foreign.C+import Foreign.C.ConstPtr+import Foreign.C.Types+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums++newtype Test = Test (# ByteArray# #)++type WGPURequestAdapterCallback =+  WGPURequestAdapterStatus ->+  Ptr WGPUAdapter ->+  -- message+  ConstPtr CChar ->+  CInt ->+  -- userdata1+  Ptr () ->+  -- userdata2+  Ptr () ->+  IO ()++foreign import ccall "wrapper" requestAdapterCallback :: WGPURequestAdapterCallback -> IO (FunPtr WGPURequestAdapterCallback)++type WGPURequestDeviceCallback =+  WGPURequestDeviceStatus ->+  Ptr WGPUDevice ->+  -- message+  ConstPtr CChar ->+  CInt ->+  -- userdata1+  Ptr () ->+  -- userdata2+  Ptr () ->+  IO ()++foreign import ccall "wrapper" requestDeviceCallback :: WGPURequestDeviceCallback -> IO (FunPtr WGPURequestDeviceCallback)
+ src/Mischief/WGPU/Common.hs view
@@ -0,0 +1,4 @@+module Mischief.WGPU.Common where++import Mischief.ECS+import Mischief.WGPU.Opaque (WGPUAdapter, WGPUDevice)
+ src/Mischief/WGPU/Core.hs view
@@ -0,0 +1,229 @@+module Mischief.WGPU.Core where++import Data.ByteString+import Data.ByteString qualified as BS+import Data.ByteString.Char8 as BS8+import Data.Data (Proxy (Proxy))+import Data.Void+import Foreign+import Foreign.C.ConstPtr+import Foreign.C.Types+import Mischief.WGPU.Callbacks+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++foreign import ccall "webgpu.h wgpuCreateInstance" c_wgpuCreateInstance :: Ptr () -> IO (Ptr WGPUInstance)++wgpuCreateInstance :: IO (Ptr WGPUInstance)+wgpuCreateInstance = c_wgpuCreateInstance nullPtr++foreign import ccall "webgpu.h wgpuInstanceCreateSurface" wgpuInstanceCreateSurface :: Ptr WGPUInstance -> ConstPtr WGPUSurfaceDescriptor -> IO (Ptr WGPUSurface)++newWGPURequestAdapterOptions :: WGPURequestAdapterOptions+newWGPURequestAdapterOptions =+  WGPURequestAdapterOptions+    { nextInChain = nullPtr,+      featureLevel = wGPUFeatureLevel_Core,+      powerPreference = wGPUPowerPreference_Undefined,+      forceFallbackAdapter = wgpuFalse,+      backendType = wGPUBackendType_Undefined,+      compatibleSurface = nullPtr+    }++newWGPURequestCallbackInfo :: WGPURequestCallbackInfo a+newWGPURequestCallbackInfo =+  WGPURequestCallbackInfo+    { nextInChain = nullPtr,+      mode = wGPUCallbackMode_WaitAnyOnly,+      callback = nullFunPtr,+      userdata1 = nullPtr,+      userdata2 = nullPtr+    }++foreign import ccall "wrapper.h wgpuInstanceProcessEvents" wgpuInstanceProcessEvents :: Ptr WGPUInstance -> IO ()++foreign import ccall "wrapper.h hs_wgpuInstanceRequestAdapter" wgpuInstanceRequestAdapter :: Ptr WGPUInstance -> Ptr WGPUSurface -> IO (Ptr WGPUAdapter)++foreign import ccall "wrapper.h hs_wgpuAdapterRequestDevice" wgpuAdapterRequestDevice :: Ptr WGPUAdapter -> IO (Ptr WGPUDevice)++foreign import ccall "webgpu.h wgpuDeviceGetQueue" wgpuDeviceGetQueue :: Ptr WGPUDevice -> IO (Ptr WGPUQueue)++foreign import ccall "webgpu.h wgpuDeviceCreateShaderModule" wgpuDeviceCreateShaderModule :: Ptr WGPUDevice -> ConstPtr WGPUShaderModuleDescriptor -> IO (Ptr WGPUShaderModule)++newWGPUPipelineLayoutDescriptor :: WGPUPipelineLayoutDescriptor+newWGPUPipelineLayoutDescriptor =+  WGPUPipelineLayoutDescriptor+    { nextInChain = nullPtr,+      label = WGPUStringView {_data = ConstPtr nullPtr, length = 0},+      bindGroupLayoutCount = 0,+      bindGroupLayouts = ConstPtr nullPtr,+      immediateSize = 0+    }++bsAsWGPUString :: ByteString -> (WGPUStringView -> IO a) -> IO a+bsAsWGPUString bs f = BS.useAsCStringLen bs $ \(ptr, length) -> f WGPUStringView {_data = ConstPtr ptr, length}++foreign import ccall "webgpu.h wgpuDeviceCreatePipelineLayout" wgpuDeviceCreatePipelineLayout :: Ptr WGPUDevice -> ConstPtr WGPUPipelineLayoutDescriptor -> IO (Ptr WGPUPipelineLayout)++foreign import ccall "webgpu.h wgpuSurfaceGetCapabilities" wgpuSurfaceGetCapabilities :: Ptr WGPUSurface -> Ptr WGPUAdapter -> Ptr WGPUSurfaceCapabilities -> IO ()++withWGPUString :: String -> (WGPUStringView -> IO a) -> IO a+withWGPUString s = bsAsWGPUString (BS8.pack s)++foreign import ccall "webgpu.h wgpuDeviceCreateRenderPipeline" wgpuDeviceCreateRenderPipeline :: Ptr WGPUDevice -> Ptr WGPURenderPipelineDescriptor -> IO (Ptr WGPURenderPipeline)++newVertexState :: WGPUVertexState+newVertexState =+  WGPUVertexState+    { nextInChain = nullPtr,+      _module = nullPtr,+      entryPoint = WGPUStringView {_data = ConstPtr nullPtr, length = 0},+      constantCount = 0,+      constants = ConstPtr nullPtr,+      bufferCount = 0,+      buffers = ConstPtr nullPtr,+      _WGPUVertexState = Proxy+    }++newFragmentState :: WGPUFragmentState+newFragmentState =+  WGPUFragmentState+    { nextInChain = nullPtr,+      _module = nullPtr,+      entryPoint = WGPUStringView {_data = ConstPtr nullPtr, length = 0},+      constantCount = 0,+      constants = ConstPtr nullPtr,+      targetCount = 0,+      targets = ConstPtr nullPtr,+      _WGPUFragmentState = Proxy+    }++newWGPUPrimitiveState :: WGPUPrimitiveState+newWGPUPrimitiveState =+  WGPUPrimitiveState+    { nextInChain = nullPtr,+      topology = wGPUPrimitiveTopology_TriangleList,+      stripIndexFormat = wGPUIndexFormat_Undefined,+      frontFace = wGPUFrontFace_CCW,+      cullMode = wGPUCullMode_Undefined,+      unclippedDepth = wgpuFalse+    }++newWGPUSurfaceConfiguration :: WGPUSurfaceConfiguration+newWGPUSurfaceConfiguration =+  WGPUSurfaceConfiguration+    { nextInChain = nullPtr,+      device = nullPtr,+      format = wGPUTextureFormat_Undefined,+      usage = wGPUTextureUsage_RenderAttachment,+      width = 0,+      height = 0,+      viewFormatCount = 0,+      viewFormats = ConstPtr nullPtr,+      alphaMode = wGPUCompositeAlphaMode_Auto,+      presentMode = wGPUPresentMode_Undefined+    }++foreign import ccall "webgpu.h wgpuSurfaceConfigure" wgpuSurfaceConfigure :: Ptr WGPUSurface -> ConstPtr WGPUSurfaceConfiguration -> IO ()++foreign import ccall "webgpu.h wgpuSurfaceGetCurrentTexture" wgpuSurfaceGetCurrentTexture :: Ptr WGPUSurface -> Ptr WGPUSurfaceTexture -> IO ()++foreign import ccall "webgpu.h wgpuTextureCreateView" wgpuTextureCreateView :: Ptr WGPUTexture -> ConstPtr WGPUTextureViewDescriptor -> IO (Ptr WGPUTextureView)++foreign import ccall "webgpu.h wgpuDeviceCreateCommandEncoder" wgpuDeviceCreateCommandEncoder :: Ptr WGPUDevice -> Ptr WGPUCommandEncoderDescriptor -> IO (Ptr WGPUCommandEncoder)++foreign import ccall "webgpu.h wgpuCommandEncoderBeginRenderPass" wgpuCommandEncoderBeginRenderPass :: Ptr WGPUCommandEncoder -> ConstPtr WGPURenderPassDescriptor -> IO (Ptr WGPURenderPassEncoder)++foreign import ccall "webgpu.h wgpuRenderPassEncoderSetPipeline" wgpuRenderPassEncoderSetPipeline :: Ptr WGPURenderPassEncoder -> Ptr WGPURenderPipeline -> IO ()++foreign import ccall "webgpu.h wgpuRenderPassEncoderDraw" wgpuRenderPassEncoderDraw :: Ptr WGPURenderPassEncoder -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()++foreign import ccall "webgpu.h wgpuRenderPassEncoderEnd" wgpuRenderPassEncoderEnd :: Ptr WGPURenderPassEncoder -> IO ()++foreign import ccall "webgpu.h wgpuCommandEncoderFinish" wgpuCommandEncoderFinish :: Ptr WGPUCommandEncoder -> ConstPtr WGPUCommandBufferDescriptor -> IO (Ptr WGPUCommandBuffer)++foreign import ccall "webgpu.h wgpuQueueSubmit" wgpuQueueSubmit :: Ptr WGPUQueue -> CSize -> ConstPtr (Ptr WGPUCommandBuffer) -> IO ()++foreign import ccall "webgpu.h wgpuRenderPassEncoderRelease" wgpuRenderPassEncoderRelease :: Ptr WGPURenderPassEncoder -> IO ()++foreign import ccall "webgpu.h wgpuRenderPipelineRelease" wgpuRenderPipelineRelease :: Ptr WGPURenderPipeline -> IO ()++foreign import ccall "webgpu.h wgpuPipelineLayoutRelease" wgpuPipelineLayoutRelease :: Ptr WGPUPipelineLayout -> IO ()++foreign import ccall "webgpu.h wgpuSurfaceCapabilitiesFreeMembers" wgpuSurfaceCapabilitiesFreeMembers :: Ptr WGPUSurfaceCapabilities -> IO ()++foreign import ccall "webgpu.h wgpuSurfacePresent" wgpuSurfacePresent :: Ptr WGPUSurface -> IO ()++foreign import ccall "webgpu.h wgpuQueueRelease" wgpuQueueRelease :: Ptr WGPUQueue -> IO ()++foreign import ccall "webgpu.h wgpuDeviceRelease" wgpuDeviceRelease :: Ptr WGPUDevice -> IO ()++foreign import ccall "webgpu.h wgpuAdapterRelease" wgpuAdapterRelease :: Ptr WGPUAdapter -> IO ()++foreign import ccall "webgpu.h wgpuSurfaceRelease" wgpuSurfaceRelease :: Ptr WGPUSurface -> IO ()++foreign import ccall "webgpu.h wgpuShaderModuleRelease" wgpuShaderModuleRelease :: Ptr WGPUShaderModule -> IO ()++foreign import ccall "webgpu.h wgpuInstanceRelease" wgpuInstanceRelease :: Ptr WGPUInstance -> IO ()++foreign import ccall "webgpu.h wgpuCommandBufferRelease" wgpuCommandBufferRelease :: Ptr WGPUCommandBuffer -> IO ()++foreign import ccall "webgpu.h wgpuCommandEncoderRelease" wgpuCommandEncoderRelease :: Ptr WGPUCommandEncoder -> IO ()++foreign import ccall "webgpu.h wgpuTextureViewRelease" wgpuTextureViewRelease :: Ptr WGPUTextureView -> IO ()++foreign import ccall "webgpu.h wgpuTextureRelease" wgpuTextureRelease :: Ptr WGPUTexture -> IO ()++wgpuColor :: Double -> Double -> Double -> Double -> WGPUColor+wgpuColor r g b a = WGPUColor (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)++foreign import ccall safe "webgpu.h wgpuQueueWriteTexture" wgpuQueueWriteTexture :: Ptr WGPUQueue -> ConstPtr WGPUTexelCopyTextureInfo -> ConstPtr Void -> CSize -> ConstPtr WGPUTexelCopyBufferLayout -> ConstPtr WGPUExtent3D -> IO ()++foreign import ccall safe "webgpu.h wgpuDeviceCreateTexture" wgpuDeviceCreateTexture :: Ptr WGPUDevice -> ConstPtr WGPUTextureDescriptor -> IO (Ptr WGPUTexture)++foreign import ccall safe "webgpu.h wgpuDeviceCreateSampler" wgpuDeviceCreateSampler :: Ptr WGPUDevice -> ConstPtr WGPUSamplerDescriptor -> IO (Ptr WGPUSampler)++foreign import ccall "webgpu.h wgpuDeviceCreateBindGroup" wgpuDeviceCreateBindGroup :: Ptr WGPUDevice -> ConstPtr WGPUBindGroupDescriptor -> IO (Ptr WGPUBindGroup)++unusedBufferLayout :: WGPUBufferBindingLayout+unusedBufferLayout =+  WGPUBufferBindingLayout+    { minBindingSize = 0,+      hasDynamicOffset = wgpuFalse,+      _type = wGPUBufferBindingType_BindingNotUsed,+      nextInChain = nullPtr+    }++unusedSamplerLayout :: WGPUSamplerBindingLayout+unusedSamplerLayout =+  WGPUSamplerBindingLayout+    { _type = wGPUSamplerBindingType_BindingNotUsed,+      nextInChain = nullPtr+    }++unusedTextureLayout :: WGPUTextureBindingLayout+unusedTextureLayout =+  WGPUTextureBindingLayout+    { sampleType = wGPUTextureSampleType_BindingNotUsed,+      multisampled = wgpuFalse,+      viewDimension = wGPUTextureViewDimension_1D,+      nextInChain = nullPtr+    }++unusedStorageTextureLayout :: WGPUStorageTextureBindingLayout+unusedStorageTextureLayout =+  WGPUStorageTextureBindingLayout+    { viewDimension = wGPUTextureViewDimension_1D,+      format = wGPUTextureFormat_ASTC10x10Unorm,+      access = wGPUStorageTextureAccess_BindingNotUsed,+      nextInChain = nullPtr+    }++foreign import ccall "webgpu.h wgpuDeviceCreateBindGroupLayout" wgpuDeviceCreateBindGroupLayout :: Ptr WGPUDevice -> ConstPtr WGPUBindGroupLayoutDescriptor -> IO (Ptr WGPUBindGroupLayout)++foreign import ccall "webgpu.h wgpuRenderPassEncoderSetBindGroup" wgpuRenderPassEncoderSetBindGroup :: Ptr WGPURenderPassEncoder -> Word32 -> Ptr WGPUBindGroup -> CSize -> ConstPtr Word32 -> IO ()++foreign import ccall "webgpu.h wgpuDeviceCreateBuffer" wgpuDeviceCreateBuffer :: Ptr WGPUDevice -> ConstPtr WGPUBufferDescriptor -> IO (Ptr WGPUBuffer)++foreign import ccall "webgpu.h wgpuQueueWriteBuffer" wgpuQueueWriteBuffer :: Ptr WGPUQueue -> Ptr WGPUBuffer -> Word64 -> ConstPtr Void -> CSize -> IO ()
+ src/Mischief/WGPU/Framework.hs view
@@ -0,0 +1,34 @@+module Mischief.WGPU.Framework where++import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Foreign (with)+import Foreign.C.ConstPtr (ConstPtr (ConstPtr))+import Foreign.Ptr+import Mischief.WGPU+import Mischief.WGPU.Opaque+import Mischief.WGPU.Types.Enums+import Mischief.WGPU.Types.General++loadShaderModule :: Ptr WGPUDevice -> String -> IO (Ptr WGPUShaderModule)+loadShaderModule device path = do+  bytes <- BS.readFile path+  loadShaderFromBytes device bytes++loadShaderFromBytes :: Ptr WGPUDevice -> ByteString -> IO (Ptr WGPUShaderModule)+loadShaderFromBytes device bytes = bsAsWGPUString bytes $ \shaderString -> do+  let shaderSource =+        WGPUShaderSourceWGSL+          { chain = WGPUChainedStruct {sType = wGPUSType_ShaderSourceWGSL, next = nullPtr},+            code = shaderString+          }++  with shaderSource $ \shaderSource -> do+    let desc =+          WGPUShaderModuleDescriptor+            { label = WGPUStringView {_data = ConstPtr nullPtr, length = 0},+              nextInChain = castPtr shaderSource+            }++    with desc $ \desc -> do+      wgpuDeviceCreateShaderModule device (ConstPtr desc)
+ src/Mischief/WGPU/Opaque.hs view
@@ -0,0 +1,37 @@+module Mischief.WGPU.Opaque where++data WGPUAdapter = WGPUAdapter++data WGPUDevice = WGPUDevice++data WGPUInstance = WGPUInstance++data WGPUQueue = WGPUQueue++data WGPUShaderModule = WGPUShaderModule++data WGPUPipelineLayout = WGPUPipelineLayout++data WGPUBindGroupLayout = WGPUBindGroupLayout++data WGPURenderPipeline = WGPURenderPipeline++data WGPUTexture = WGPUTexture++data WGPUTextureView = WGPUTextureView++data WGPUCommandBuffer = WGPUCommandBuffer++data WGPUCommandEncoder = WGPUCommandEncoder++data WGPUQuerySet = WGPUQuerySet++data WGPURenderPassEncoder = WGPURenderPassEncoder++data WGPUFuture = WGPUFuture++data WGPUSampler = WGPUSampler++data WGPUBuffer = WGPUBuffer++data WGPUBindGroup = WGPUBindGroup
+ src/Mischief/WGPU/Types/Enums.hsc view
@@ -0,0 +1,1578 @@+#include "webgpu.h"++module Mischief.WGPU.Types.Enums where++import Foreign +import Foreign.C.ConstPtr+import Foreign.C.Types+import Data.Void++import Data.Word (Word64)++newtype WGPUSType = WGPUSType CUInt deriving (Eq, Ord, Show)++instance Storable WGPUSType where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUSType x+  poke ptr (WGPUSType x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUSType_ShaderSourceSPIRV :: WGPUSType+wGPUSType_ShaderSourceSPIRV = WGPUSType #const WGPUSType_ShaderSourceSPIRV ++wGPUSType_ShaderSourceWGSL :: WGPUSType+wGPUSType_ShaderSourceWGSL = WGPUSType #const WGPUSType_ShaderSourceWGSL ++wGPUSType_RenderPassMaxDrawCount :: WGPUSType+wGPUSType_RenderPassMaxDrawCount = WGPUSType #const WGPUSType_RenderPassMaxDrawCount ++wGPUSType_SurfaceSourceMetalLayer :: WGPUSType+wGPUSType_SurfaceSourceMetalLayer = WGPUSType #const WGPUSType_SurfaceSourceMetalLayer ++wGPUSType_SurfaceSourceWindowsHWND :: WGPUSType+wGPUSType_SurfaceSourceWindowsHWND = WGPUSType #const WGPUSType_SurfaceSourceWindowsHWND ++wGPUSType_SurfaceSourceXlibWindow :: WGPUSType+wGPUSType_SurfaceSourceXlibWindow = WGPUSType #const WGPUSType_SurfaceSourceXlibWindow ++wGPUSType_SurfaceSourceWaylandSurface :: WGPUSType+wGPUSType_SurfaceSourceWaylandSurface = WGPUSType #const WGPUSType_SurfaceSourceWaylandSurface ++wGPUSType_SurfaceSourceAndroidNativeWindow :: WGPUSType+wGPUSType_SurfaceSourceAndroidNativeWindow = WGPUSType #const WGPUSType_SurfaceSourceAndroidNativeWindow ++wGPUSType_SurfaceSourceXCBWindow :: WGPUSType+wGPUSType_SurfaceSourceXCBWindow = WGPUSType #const WGPUSType_SurfaceSourceXCBWindow ++wGPUSType_SurfaceColorManagement :: WGPUSType+wGPUSType_SurfaceColorManagement = WGPUSType #const WGPUSType_SurfaceColorManagement ++wGPUSType_RequestAdapterWebXROptions :: WGPUSType+wGPUSType_RequestAdapterWebXROptions = WGPUSType #const WGPUSType_RequestAdapterWebXROptions ++wGPUSType_TextureComponentSwizzleDescriptor :: WGPUSType+wGPUSType_TextureComponentSwizzleDescriptor = WGPUSType #const WGPUSType_TextureComponentSwizzleDescriptor ++wGPUSType_ExternalTextureBindingLayout :: WGPUSType+wGPUSType_ExternalTextureBindingLayout = WGPUSType #const WGPUSType_ExternalTextureBindingLayout ++wGPUSType_ExternalTextureBindingEntry :: WGPUSType+wGPUSType_ExternalTextureBindingEntry = WGPUSType #const WGPUSType_ExternalTextureBindingEntry ++wGPUSType_CompatibilityModeLimits :: WGPUSType+wGPUSType_CompatibilityModeLimits = WGPUSType #const WGPUSType_CompatibilityModeLimits ++wGPUSType_TextureBindingViewDimension :: WGPUSType+wGPUSType_TextureBindingViewDimension = WGPUSType #const WGPUSType_TextureBindingViewDimension ++wGPUSType_Force32 :: WGPUSType+wGPUSType_Force32 = WGPUSType #const WGPUSType_Force32 ++++newtype WGPUFeatureLevel = WGPUFeatureLevel CUInt deriving (Eq, Ord, Show)+++instance Storable WGPUFeatureLevel where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUFeatureLevel x+  poke ptr (WGPUFeatureLevel x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUFeatureLevel_Undefined :: WGPUFeatureLevel+wGPUFeatureLevel_Undefined = WGPUFeatureLevel #const WGPUFeatureLevel_Undefined++wGPUFeatureLevel_Compatibility :: WGPUFeatureLevel+wGPUFeatureLevel_Compatibility = WGPUFeatureLevel #const WGPUFeatureLevel_Compatibility++wGPUFeatureLevel_Core :: WGPUFeatureLevel+wGPUFeatureLevel_Core = WGPUFeatureLevel #const WGPUFeatureLevel_Core++wGPUFeatureLevel_Force32 :: WGPUFeatureLevel+wGPUFeatureLevel_Force32 = WGPUFeatureLevel #const WGPUFeatureLevel_Force32+++newtype WGPUPowerPreference = WGPUPowerPreference CUInt deriving (Eq, Ord, Show)++instance Storable WGPUPowerPreference where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUPowerPreference x+  poke ptr (WGPUPowerPreference x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUPowerPreference_Undefined :: WGPUPowerPreference+wGPUPowerPreference_Undefined = WGPUPowerPreference #const WGPUPowerPreference_Undefined++wGPUPowerPreference_LowPower :: WGPUPowerPreference+wGPUPowerPreference_LowPower = WGPUPowerPreference #const WGPUPowerPreference_LowPower++wGPUPowerPreference_HighPerformance :: WGPUPowerPreference+wGPUPowerPreference_HighPerformance = WGPUPowerPreference #const WGPUPowerPreference_HighPerformance++wGPUPowerPreference_Force32 :: WGPUPowerPreference+wGPUPowerPreference_Force32 = WGPUPowerPreference #const WGPUPowerPreference_Force32++newtype WGPUBool = WGPUBool Word32 deriving newtype (Storable)+wgpuFalse, wgpuTrue :: WGPUBool+wgpuFalse = WGPUBool 0+wgpuTrue  = WGPUBool 1++newtype WGPUBackendType = WGPUBackendType CUInt deriving (Eq, Ord, Show)++instance Storable WGPUBackendType where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUBackendType x+  poke ptr (WGPUBackendType x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x+++wGPUBackendType_Undefined :: WGPUBackendType+wGPUBackendType_Undefined = WGPUBackendType #const WGPUBackendType_Undefined++wGPUBackendType_Null :: WGPUBackendType+wGPUBackendType_Null = WGPUBackendType #const WGPUBackendType_Null++wGPUBackendType_WebGPU :: WGPUBackendType+wGPUBackendType_WebGPU = WGPUBackendType #const WGPUBackendType_WebGPU++wGPUBackendType_D3D11 :: WGPUBackendType+wGPUBackendType_D3D11 = WGPUBackendType #const WGPUBackendType_D3D11++wGPUBackendType_D3D12 :: WGPUBackendType+wGPUBackendType_D3D12 = WGPUBackendType #const WGPUBackendType_D3D12++wGPUBackendType_Metal :: WGPUBackendType+wGPUBackendType_Metal = WGPUBackendType #const WGPUBackendType_Metal++wGPUBackendType_Vulkan :: WGPUBackendType+wGPUBackendType_Vulkan = WGPUBackendType #const WGPUBackendType_Vulkan++wGPUBackendType_OpenGL :: WGPUBackendType+wGPUBackendType_OpenGL = WGPUBackendType #const WGPUBackendType_OpenGL++wGPUBackendType_OpenGLES :: WGPUBackendType+wGPUBackendType_OpenGLES = WGPUBackendType #const WGPUBackendType_OpenGLES++wGPUBackendType_Force32 :: WGPUBackendType+wGPUBackendType_Force32 = WGPUBackendType #const WGPUBackendType_Force32+++newtype WGPURequestAdapterStatus = WGPURequestAdapterStatus CUInt deriving (Eq, Ord, Show)++instance Storable WGPURequestAdapterStatus where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPURequestAdapterStatus x+  poke ptr (WGPURequestAdapterStatus x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x+++wGPURequestAdapterStatus_Success :: WGPURequestAdapterStatus+wGPURequestAdapterStatus_Success = WGPURequestAdapterStatus #const WGPURequestAdapterStatus_Success++wGPURequestAdapterStatus_CallbackCancelled :: WGPURequestAdapterStatus+wGPURequestAdapterStatus_CallbackCancelled = WGPURequestAdapterStatus #const WGPURequestAdapterStatus_CallbackCancelled++wGPURequestAdapterStatus_Unavailable :: WGPURequestAdapterStatus+wGPURequestAdapterStatus_Unavailable = WGPURequestAdapterStatus #const WGPURequestAdapterStatus_Unavailable++wGPURequestAdapterStatus_Error :: WGPURequestAdapterStatus+wGPURequestAdapterStatus_Error = WGPURequestAdapterStatus #const WGPURequestAdapterStatus_Error++wGPURequestAdapterStatus_Force32 :: WGPURequestAdapterStatus+wGPURequestAdapterStatus_Force32 = WGPURequestAdapterStatus #const WGPURequestAdapterStatus_Force32+++newtype WGPUCallbackMode = WGPUCallbackMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUCallbackMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUCallbackMode x+  poke ptr (WGPUCallbackMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x+++wGPUCallbackMode_WaitAnyOnly :: WGPUCallbackMode+wGPUCallbackMode_WaitAnyOnly = WGPUCallbackMode #const WGPUCallbackMode_WaitAnyOnly++wGPUCallbackMode_AllowProcessEvents :: WGPUCallbackMode+wGPUCallbackMode_AllowProcessEvents = WGPUCallbackMode #const WGPUCallbackMode_AllowProcessEvents++wGPUCallbackMode_AllowSpontaneous :: WGPUCallbackMode+wGPUCallbackMode_AllowSpontaneous = WGPUCallbackMode #const WGPUCallbackMode_AllowSpontaneous++wGPUCallbackMode_Force32 :: WGPUCallbackMode+wGPUCallbackMode_Force32 = WGPUCallbackMode #const WGPUCallbackMode_Force32+++newtype WGPURequestDeviceStatus = WGPURequestDeviceStatus CUInt deriving (Eq, Ord, Show)+++instance Storable WGPURequestDeviceStatus where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPURequestDeviceStatus x+  poke ptr (WGPURequestDeviceStatus x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x+++wGPURequestDeviceStatus_Success :: WGPURequestDeviceStatus+wGPURequestDeviceStatus_Success = WGPURequestDeviceStatus #const WGPURequestDeviceStatus_Success++wGPURequestDeviceStatus_CallbackCancelled :: WGPURequestDeviceStatus+wGPURequestDeviceStatus_CallbackCancelled = WGPURequestDeviceStatus #const WGPURequestDeviceStatus_CallbackCancelled++wGPURequestDeviceStatus_Error :: WGPURequestDeviceStatus+wGPURequestDeviceStatus_Error = WGPURequestDeviceStatus #const WGPURequestDeviceStatus_Error++wGPURequestDeviceStatus_Force32 :: WGPURequestDeviceStatus+wGPURequestDeviceStatus_Force32 = WGPURequestDeviceStatus #const WGPURequestDeviceStatus_Force32++newtype WGPUFlags = WGPUFlags Word64 deriving newtype (Show, Eq, Storable, Num, Bits)++newtype WGPUShaderStage = WGPUShaderStage WGPUFlags deriving newtype (Show, Eq, Storable, Num, Bits)++wGPUShaderStage_None :: WGPUShaderStage +wGPUShaderStage_None =  WGPUShaderStage #const WGPUShaderStage_None++wGPUShaderStage_Vertex :: WGPUShaderStage +wGPUShaderStage_Vertex =  WGPUShaderStage #const WGPUShaderStage_Vertex++wGPUShaderStage_Fragment :: WGPUShaderStage +wGPUShaderStage_Fragment =  WGPUShaderStage #const WGPUShaderStage_Fragment++wGPUShaderStage_Compute :: WGPUShaderStage +wGPUShaderStage_Compute =  WGPUShaderStage #const WGPUShaderStage_Compute++newtype WGPUBufferUsage = WGPUBufferUsage WGPUFlags deriving newtype (Show, Eq, Storable, Num, Bits)++wGPUBufferUsage_None :: WGPUBufferUsage +wGPUBufferUsage_None =  WGPUBufferUsage #const WGPUBufferUsage_None++wGPUBufferUsage_MapRead :: WGPUBufferUsage +wGPUBufferUsage_MapRead =  WGPUBufferUsage #const WGPUBufferUsage_MapRead++wGPUBufferUsage_MapWrite :: WGPUBufferUsage +wGPUBufferUsage_MapWrite =  WGPUBufferUsage #const WGPUBufferUsage_MapWrite++wGPUBufferUsage_CopySrc :: WGPUBufferUsage +wGPUBufferUsage_CopySrc =  WGPUBufferUsage #const WGPUBufferUsage_CopySrc++wGPUBufferUsage_CopyDst :: WGPUBufferUsage +wGPUBufferUsage_CopyDst =  WGPUBufferUsage #const WGPUBufferUsage_CopyDst++wGPUBufferUsage_Index :: WGPUBufferUsage +wGPUBufferUsage_Index =  WGPUBufferUsage #const WGPUBufferUsage_Index++wGPUBufferUsage_Vertex :: WGPUBufferUsage +wGPUBufferUsage_Vertex =  WGPUBufferUsage #const WGPUBufferUsage_Vertex++wGPUBufferUsage_Uniform :: WGPUBufferUsage +wGPUBufferUsage_Uniform =  WGPUBufferUsage #const WGPUBufferUsage_Uniform++wGPUBufferUsage_Storage :: WGPUBufferUsage +wGPUBufferUsage_Storage =  WGPUBufferUsage #const WGPUBufferUsage_Storage++wGPUBufferUsage_Indirect :: WGPUBufferUsage +wGPUBufferUsage_Indirect =  WGPUBufferUsage #const WGPUBufferUsage_Indirect++wGPUBufferUsage_QueryResolve :: WGPUBufferUsage +wGPUBufferUsage_QueryResolve =  WGPUBufferUsage #const WGPUBufferUsage_QueryResolve+++newtype WGPUBufferBindingType = WGPUBufferBindingType CUInt deriving (Eq, Ord, Show)++instance Storable WGPUBufferBindingType where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUBufferBindingType x+  poke ptr (WGPUBufferBindingType x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUBufferBindingType_BindingNotUsed :: WGPUBufferBindingType+wGPUBufferBindingType_BindingNotUsed = WGPUBufferBindingType #const WGPUBufferBindingType_BindingNotUsed++wGPUBufferBindingType_Undefined :: WGPUBufferBindingType+wGPUBufferBindingType_Undefined = WGPUBufferBindingType #const WGPUBufferBindingType_Undefined++wGPUBufferBindingType_Uniform :: WGPUBufferBindingType+wGPUBufferBindingType_Uniform = WGPUBufferBindingType #const WGPUBufferBindingType_Uniform++wGPUBufferBindingType_Storage :: WGPUBufferBindingType+wGPUBufferBindingType_Storage = WGPUBufferBindingType #const WGPUBufferBindingType_Storage++wGPUBufferBindingType_ReadOnlyStorage :: WGPUBufferBindingType+wGPUBufferBindingType_ReadOnlyStorage = WGPUBufferBindingType #const WGPUBufferBindingType_ReadOnlyStorage++wGPUBufferBindingType_Force32 :: WGPUBufferBindingType+wGPUBufferBindingType_Force32 = WGPUBufferBindingType #const WGPUBufferBindingType_Force32++newtype WGPUBlendFactor = WGPUBlendFactor CUInt deriving (Eq, Ord, Show)++instance Storable WGPUBlendFactor where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUBlendFactor x+  poke ptr (WGPUBlendFactor x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUBlendFactor_Undefined :: WGPUBlendFactor+wGPUBlendFactor_Undefined = WGPUBlendFactor #const WGPUBlendFactor_Undefined++wGPUBlendFactor_Zero :: WGPUBlendFactor+wGPUBlendFactor_Zero = WGPUBlendFactor #const WGPUBlendFactor_Zero++wGPUBlendFactor_One :: WGPUBlendFactor+wGPUBlendFactor_One = WGPUBlendFactor #const WGPUBlendFactor_One++wGPUBlendFactor_Src :: WGPUBlendFactor+wGPUBlendFactor_Src = WGPUBlendFactor #const WGPUBlendFactor_Src++wGPUBlendFactor_OneMinusSrc :: WGPUBlendFactor+wGPUBlendFactor_OneMinusSrc = WGPUBlendFactor #const WGPUBlendFactor_OneMinusSrc++wGPUBlendFactor_SrcAlpha :: WGPUBlendFactor+wGPUBlendFactor_SrcAlpha = WGPUBlendFactor #const WGPUBlendFactor_SrcAlpha++wGPUBlendFactor_OneMinusSrcAlpha :: WGPUBlendFactor+wGPUBlendFactor_OneMinusSrcAlpha = WGPUBlendFactor #const WGPUBlendFactor_OneMinusSrcAlpha++wGPUBlendFactor_Dst :: WGPUBlendFactor+wGPUBlendFactor_Dst = WGPUBlendFactor #const WGPUBlendFactor_Dst++wGPUBlendFactor_OneMinusDst :: WGPUBlendFactor+wGPUBlendFactor_OneMinusDst = WGPUBlendFactor #const WGPUBlendFactor_OneMinusDst++wGPUBlendFactor_DstAlpha :: WGPUBlendFactor+wGPUBlendFactor_DstAlpha = WGPUBlendFactor #const WGPUBlendFactor_DstAlpha++wGPUBlendFactor_OneMinusDstAlpha :: WGPUBlendFactor+wGPUBlendFactor_OneMinusDstAlpha = WGPUBlendFactor #const WGPUBlendFactor_OneMinusDstAlpha++wGPUBlendFactor_SrcAlphaSaturated :: WGPUBlendFactor+wGPUBlendFactor_SrcAlphaSaturated = WGPUBlendFactor #const WGPUBlendFactor_SrcAlphaSaturated++wGPUBlendFactor_Constant :: WGPUBlendFactor+wGPUBlendFactor_Constant = WGPUBlendFactor #const WGPUBlendFactor_Constant++wGPUBlendFactor_OneMinusConstant :: WGPUBlendFactor+wGPUBlendFactor_OneMinusConstant = WGPUBlendFactor #const WGPUBlendFactor_OneMinusConstant++wGPUBlendFactor_Src1 :: WGPUBlendFactor+wGPUBlendFactor_Src1 = WGPUBlendFactor #const WGPUBlendFactor_Src1++wGPUBlendFactor_OneMinusSrc1 :: WGPUBlendFactor+wGPUBlendFactor_OneMinusSrc1 = WGPUBlendFactor #const WGPUBlendFactor_OneMinusSrc1++wGPUBlendFactor_Src1Alpha :: WGPUBlendFactor+wGPUBlendFactor_Src1Alpha = WGPUBlendFactor #const WGPUBlendFactor_Src1Alpha++wGPUBlendFactor_OneMinusSrc1Alpha :: WGPUBlendFactor+wGPUBlendFactor_OneMinusSrc1Alpha = WGPUBlendFactor #const WGPUBlendFactor_OneMinusSrc1Alpha++wGPUBlendFactor_Force32 :: WGPUBlendFactor+wGPUBlendFactor_Force32 = WGPUBlendFactor #const WGPUBlendFactor_Force32+++newtype WGPUBlendOperation = WGPUBlendOperation CUInt deriving (Eq, Ord, Show)++instance Storable WGPUBlendOperation where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUBlendOperation x+  poke ptr (WGPUBlendOperation x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUBlendOperation_Undefined :: WGPUBlendOperation+wGPUBlendOperation_Undefined = WGPUBlendOperation #const WGPUBlendOperation_Undefined++wGPUBlendOperation_Add :: WGPUBlendOperation+wGPUBlendOperation_Add = WGPUBlendOperation #const WGPUBlendOperation_Add++wGPUBlendOperation_Subtract :: WGPUBlendOperation+wGPUBlendOperation_Subtract = WGPUBlendOperation #const WGPUBlendOperation_Subtract++wGPUBlendOperation_ReverseSubtract :: WGPUBlendOperation+wGPUBlendOperation_ReverseSubtract = WGPUBlendOperation #const WGPUBlendOperation_ReverseSubtract++wGPUBlendOperation_Min :: WGPUBlendOperation+wGPUBlendOperation_Min = WGPUBlendOperation #const WGPUBlendOperation_Min++wGPUBlendOperation_Max :: WGPUBlendOperation+wGPUBlendOperation_Max = WGPUBlendOperation #const WGPUBlendOperation_Max++wGPUBlendOperation_Force32 :: WGPUBlendOperation+wGPUBlendOperation_Force32 = WGPUBlendOperation #const WGPUBlendOperation_Force32++newtype WGPUBufferMapState = WGPUBufferMapState CUInt deriving (Eq, Ord, Show)++instance Storable WGPUBufferMapState where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUBufferMapState x+  poke ptr (WGPUBufferMapState x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUBufferMapState_Unmapped :: WGPUBufferMapState+wGPUBufferMapState_Unmapped = WGPUBufferMapState #const WGPUBufferMapState_Unmapped++wGPUBufferMapState_Pending :: WGPUBufferMapState+wGPUBufferMapState_Pending = WGPUBufferMapState #const WGPUBufferMapState_Pending++wGPUBufferMapState_Mapped :: WGPUBufferMapState+wGPUBufferMapState_Mapped = WGPUBufferMapState #const WGPUBufferMapState_Mapped++wGPUBufferMapState_Force32 :: WGPUBufferMapState+wGPUBufferMapState_Force32 = WGPUBufferMapState #const WGPUBufferMapState_Force32+++newtype WGPUTextureSampleType = WGPUTextureSampleType CUInt deriving (Eq, Ord, Show)++instance Storable WGPUTextureSampleType where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUTextureSampleType x+  poke ptr (WGPUTextureSampleType x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUTextureSampleType_BindingNotUsed :: WGPUTextureSampleType+wGPUTextureSampleType_BindingNotUsed = WGPUTextureSampleType #const WGPUTextureSampleType_BindingNotUsed++wGPUTextureSampleType_Undefined :: WGPUTextureSampleType+wGPUTextureSampleType_Undefined = WGPUTextureSampleType #const WGPUTextureSampleType_Undefined++wGPUTextureSampleType_Float :: WGPUTextureSampleType+wGPUTextureSampleType_Float = WGPUTextureSampleType #const WGPUTextureSampleType_Float++wGPUTextureSampleType_UnfilterableFloat :: WGPUTextureSampleType+wGPUTextureSampleType_UnfilterableFloat = WGPUTextureSampleType #const WGPUTextureSampleType_UnfilterableFloat++wGPUTextureSampleType_Depth :: WGPUTextureSampleType+wGPUTextureSampleType_Depth = WGPUTextureSampleType #const WGPUTextureSampleType_Depth++wGPUTextureSampleType_Sint :: WGPUTextureSampleType+wGPUTextureSampleType_Sint = WGPUTextureSampleType #const WGPUTextureSampleType_Sint++wGPUTextureSampleType_Uint :: WGPUTextureSampleType+wGPUTextureSampleType_Uint = WGPUTextureSampleType #const WGPUTextureSampleType_Uint++wGPUTextureSampleType_Force32 :: WGPUTextureSampleType+wGPUTextureSampleType_Force32 = WGPUTextureSampleType #const WGPUTextureSampleType_Force32++newtype WGPUTextureViewDimension = WGPUTextureViewDimension CUInt deriving (Eq, Ord, Show)++instance Storable WGPUTextureViewDimension where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUTextureViewDimension x+  poke ptr (WGPUTextureViewDimension x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUTextureViewDimension_Undefined :: WGPUTextureViewDimension+wGPUTextureViewDimension_Undefined = WGPUTextureViewDimension #const WGPUTextureViewDimension_Undefined++wGPUTextureViewDimension_1D :: WGPUTextureViewDimension+wGPUTextureViewDimension_1D = WGPUTextureViewDimension #const WGPUTextureViewDimension_1D++wGPUTextureViewDimension_2D :: WGPUTextureViewDimension+wGPUTextureViewDimension_2D = WGPUTextureViewDimension #const WGPUTextureViewDimension_2D++wGPUTextureViewDimension_2DArray :: WGPUTextureViewDimension+wGPUTextureViewDimension_2DArray = WGPUTextureViewDimension #const WGPUTextureViewDimension_2DArray++wGPUTextureViewDimension_Cube :: WGPUTextureViewDimension+wGPUTextureViewDimension_Cube = WGPUTextureViewDimension #const WGPUTextureViewDimension_Cube++wGPUTextureViewDimension_CubeArray :: WGPUTextureViewDimension+wGPUTextureViewDimension_CubeArray = WGPUTextureViewDimension #const WGPUTextureViewDimension_CubeArray++wGPUTextureViewDimension_3D :: WGPUTextureViewDimension+wGPUTextureViewDimension_3D = WGPUTextureViewDimension #const WGPUTextureViewDimension_3D++wGPUTextureViewDimension_Force32 :: WGPUTextureViewDimension+wGPUTextureViewDimension_Force32 = WGPUTextureViewDimension #const WGPUTextureViewDimension_Force32+++newtype WGPUToneMappingMode = WGPUToneMappingMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUToneMappingMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUToneMappingMode x+  poke ptr (WGPUToneMappingMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUToneMappingMode_Standard :: WGPUToneMappingMode+wGPUToneMappingMode_Standard = WGPUToneMappingMode #const WGPUToneMappingMode_Standard++wGPUToneMappingMode_Extended :: WGPUToneMappingMode+wGPUToneMappingMode_Extended = WGPUToneMappingMode #const WGPUToneMappingMode_Extended++wGPUToneMappingMode_Force32 :: WGPUToneMappingMode+wGPUToneMappingMode_Force32 = WGPUToneMappingMode #const WGPUToneMappingMode_Force32+++newtype WGPUVertexFormat = WGPUVertexFormat CUInt deriving (Eq, Ord, Show)++instance Storable WGPUVertexFormat where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUVertexFormat x+  poke ptr (WGPUVertexFormat x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUVertexFormat_Uint8 :: WGPUVertexFormat+wGPUVertexFormat_Uint8 = WGPUVertexFormat #const WGPUVertexFormat_Uint8++wGPUVertexFormat_Uint8x2 :: WGPUVertexFormat+wGPUVertexFormat_Uint8x2 = WGPUVertexFormat #const WGPUVertexFormat_Uint8x2++wGPUVertexFormat_Uint8x4 :: WGPUVertexFormat+wGPUVertexFormat_Uint8x4 = WGPUVertexFormat #const WGPUVertexFormat_Uint8x4++wGPUVertexFormat_Sint8 :: WGPUVertexFormat+wGPUVertexFormat_Sint8 = WGPUVertexFormat #const WGPUVertexFormat_Sint8++wGPUVertexFormat_Sint8x2 :: WGPUVertexFormat+wGPUVertexFormat_Sint8x2 = WGPUVertexFormat #const WGPUVertexFormat_Sint8x2++wGPUVertexFormat_Sint8x4 :: WGPUVertexFormat+wGPUVertexFormat_Sint8x4 = WGPUVertexFormat #const WGPUVertexFormat_Sint8x4++wGPUVertexFormat_Unorm8 :: WGPUVertexFormat+wGPUVertexFormat_Unorm8 = WGPUVertexFormat #const WGPUVertexFormat_Unorm8++wGPUVertexFormat_Unorm8x2 :: WGPUVertexFormat+wGPUVertexFormat_Unorm8x2 = WGPUVertexFormat #const WGPUVertexFormat_Unorm8x2++wGPUVertexFormat_Unorm8x4 :: WGPUVertexFormat+wGPUVertexFormat_Unorm8x4 = WGPUVertexFormat #const WGPUVertexFormat_Unorm8x4++wGPUVertexFormat_Snorm8 :: WGPUVertexFormat+wGPUVertexFormat_Snorm8 = WGPUVertexFormat #const WGPUVertexFormat_Snorm8++wGPUVertexFormat_Snorm8x2 :: WGPUVertexFormat+wGPUVertexFormat_Snorm8x2 = WGPUVertexFormat #const WGPUVertexFormat_Snorm8x2++wGPUVertexFormat_Snorm8x4 :: WGPUVertexFormat+wGPUVertexFormat_Snorm8x4 = WGPUVertexFormat #const WGPUVertexFormat_Snorm8x4++wGPUVertexFormat_Uint16 :: WGPUVertexFormat+wGPUVertexFormat_Uint16 = WGPUVertexFormat #const WGPUVertexFormat_Uint16++wGPUVertexFormat_Uint16x2 :: WGPUVertexFormat+wGPUVertexFormat_Uint16x2 = WGPUVertexFormat #const WGPUVertexFormat_Uint16x2++wGPUVertexFormat_Uint16x4 :: WGPUVertexFormat+wGPUVertexFormat_Uint16x4 = WGPUVertexFormat #const WGPUVertexFormat_Uint16x4++wGPUVertexFormat_Sint16 :: WGPUVertexFormat+wGPUVertexFormat_Sint16 = WGPUVertexFormat #const WGPUVertexFormat_Sint16++wGPUVertexFormat_Sint16x2 :: WGPUVertexFormat+wGPUVertexFormat_Sint16x2 = WGPUVertexFormat #const WGPUVertexFormat_Sint16x2++wGPUVertexFormat_Sint16x4 :: WGPUVertexFormat+wGPUVertexFormat_Sint16x4 = WGPUVertexFormat #const WGPUVertexFormat_Sint16x4++wGPUVertexFormat_Unorm16 :: WGPUVertexFormat+wGPUVertexFormat_Unorm16 = WGPUVertexFormat #const WGPUVertexFormat_Unorm16++wGPUVertexFormat_Unorm16x2 :: WGPUVertexFormat+wGPUVertexFormat_Unorm16x2 = WGPUVertexFormat #const WGPUVertexFormat_Unorm16x2++wGPUVertexFormat_Unorm16x4 :: WGPUVertexFormat+wGPUVertexFormat_Unorm16x4 = WGPUVertexFormat #const WGPUVertexFormat_Unorm16x4++wGPUVertexFormat_Snorm16 :: WGPUVertexFormat+wGPUVertexFormat_Snorm16 = WGPUVertexFormat #const WGPUVertexFormat_Snorm16++wGPUVertexFormat_Snorm16x2 :: WGPUVertexFormat+wGPUVertexFormat_Snorm16x2 = WGPUVertexFormat #const WGPUVertexFormat_Snorm16x2++wGPUVertexFormat_Snorm16x4 :: WGPUVertexFormat+wGPUVertexFormat_Snorm16x4 = WGPUVertexFormat #const WGPUVertexFormat_Snorm16x4++wGPUVertexFormat_Float16 :: WGPUVertexFormat+wGPUVertexFormat_Float16 = WGPUVertexFormat #const WGPUVertexFormat_Float16++wGPUVertexFormat_Float16x2 :: WGPUVertexFormat+wGPUVertexFormat_Float16x2 = WGPUVertexFormat #const WGPUVertexFormat_Float16x2++wGPUVertexFormat_Float16x4 :: WGPUVertexFormat+wGPUVertexFormat_Float16x4 = WGPUVertexFormat #const WGPUVertexFormat_Float16x4++wGPUVertexFormat_Float32 :: WGPUVertexFormat+wGPUVertexFormat_Float32 = WGPUVertexFormat #const WGPUVertexFormat_Float32++wGPUVertexFormat_Float32x2 :: WGPUVertexFormat+wGPUVertexFormat_Float32x2 = WGPUVertexFormat #const WGPUVertexFormat_Float32x2++wGPUVertexFormat_Float32x3 :: WGPUVertexFormat+wGPUVertexFormat_Float32x3 = WGPUVertexFormat #const WGPUVertexFormat_Float32x3++wGPUVertexFormat_Float32x4 :: WGPUVertexFormat+wGPUVertexFormat_Float32x4 = WGPUVertexFormat #const WGPUVertexFormat_Float32x4++wGPUVertexFormat_Uint32 :: WGPUVertexFormat+wGPUVertexFormat_Uint32 = WGPUVertexFormat #const WGPUVertexFormat_Uint32++wGPUVertexFormat_Uint32x2 :: WGPUVertexFormat+wGPUVertexFormat_Uint32x2 = WGPUVertexFormat #const WGPUVertexFormat_Uint32x2++wGPUVertexFormat_Uint32x3 :: WGPUVertexFormat+wGPUVertexFormat_Uint32x3 = WGPUVertexFormat #const WGPUVertexFormat_Uint32x3++wGPUVertexFormat_Uint32x4 :: WGPUVertexFormat+wGPUVertexFormat_Uint32x4 = WGPUVertexFormat #const WGPUVertexFormat_Uint32x4++wGPUVertexFormat_Sint32 :: WGPUVertexFormat+wGPUVertexFormat_Sint32 = WGPUVertexFormat #const WGPUVertexFormat_Sint32++wGPUVertexFormat_Sint32x2 :: WGPUVertexFormat+wGPUVertexFormat_Sint32x2 = WGPUVertexFormat #const WGPUVertexFormat_Sint32x2++wGPUVertexFormat_Sint32x3 :: WGPUVertexFormat+wGPUVertexFormat_Sint32x3 = WGPUVertexFormat #const WGPUVertexFormat_Sint32x3++wGPUVertexFormat_Sint32x4 :: WGPUVertexFormat+wGPUVertexFormat_Sint32x4 = WGPUVertexFormat #const WGPUVertexFormat_Sint32x4++wGPUVertexFormat_Unorm10_10_10_2 :: WGPUVertexFormat+wGPUVertexFormat_Unorm10_10_10_2 = WGPUVertexFormat #const WGPUVertexFormat_Unorm10_10_10_2++wGPUVertexFormat_Unorm8x4BGRA :: WGPUVertexFormat+wGPUVertexFormat_Unorm8x4BGRA = WGPUVertexFormat #const WGPUVertexFormat_Unorm8x4BGRA++wGPUVertexFormat_Force32 :: WGPUVertexFormat+wGPUVertexFormat_Force32 = WGPUVertexFormat #const WGPUVertexFormat_Force32++newtype WGPUVertexStepMode = WGPUVertexStepMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUVertexStepMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUVertexStepMode x+  poke ptr (WGPUVertexStepMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUVertexStepMode_Undefined :: WGPUVertexStepMode+wGPUVertexStepMode_Undefined = WGPUVertexStepMode #const WGPUVertexStepMode_Undefined++wGPUVertexStepMode_Vertex :: WGPUVertexStepMode+wGPUVertexStepMode_Vertex = WGPUVertexStepMode #const WGPUVertexStepMode_Vertex++wGPUVertexStepMode_Instance :: WGPUVertexStepMode+wGPUVertexStepMode_Instance = WGPUVertexStepMode #const WGPUVertexStepMode_Instance++wGPUVertexStepMode_Force32 :: WGPUVertexStepMode+wGPUVertexStepMode_Force32 = WGPUVertexStepMode #const WGPUVertexStepMode_Force32++newtype WGPUStorageTextureAccess = WGPUStorageTextureAccess CUInt deriving (Eq, Ord, Show)++instance Storable WGPUStorageTextureAccess where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUStorageTextureAccess x+  poke ptr (WGPUStorageTextureAccess x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUStorageTextureAccess_BindingNotUsed :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_BindingNotUsed = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_BindingNotUsed++wGPUStorageTextureAccess_Undefined :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_Undefined = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_Undefined++wGPUStorageTextureAccess_WriteOnly :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_WriteOnly = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_WriteOnly++wGPUStorageTextureAccess_ReadOnly :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_ReadOnly = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_ReadOnly++wGPUStorageTextureAccess_ReadWrite :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_ReadWrite = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_ReadWrite++wGPUStorageTextureAccess_Force32 :: WGPUStorageTextureAccess+wGPUStorageTextureAccess_Force32 = WGPUStorageTextureAccess #const WGPUStorageTextureAccess_Force32+++newtype WGPUTextureFormat = WGPUTextureFormat CUInt deriving (Eq, Ord, Show)++instance Storable WGPUTextureFormat where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUTextureFormat x+  poke ptr (WGPUTextureFormat x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUTextureFormat_Undefined :: WGPUTextureFormat+wGPUTextureFormat_Undefined = WGPUTextureFormat #const WGPUTextureFormat_Undefined++wGPUTextureFormat_R8Unorm :: WGPUTextureFormat+wGPUTextureFormat_R8Unorm = WGPUTextureFormat #const WGPUTextureFormat_R8Unorm++wGPUTextureFormat_R8Snorm :: WGPUTextureFormat+wGPUTextureFormat_R8Snorm = WGPUTextureFormat #const WGPUTextureFormat_R8Snorm++wGPUTextureFormat_R8Uint :: WGPUTextureFormat+wGPUTextureFormat_R8Uint = WGPUTextureFormat #const WGPUTextureFormat_R8Uint++wGPUTextureFormat_R8Sint :: WGPUTextureFormat+wGPUTextureFormat_R8Sint = WGPUTextureFormat #const WGPUTextureFormat_R8Sint++wGPUTextureFormat_R16Unorm :: WGPUTextureFormat+wGPUTextureFormat_R16Unorm = WGPUTextureFormat #const WGPUTextureFormat_R16Unorm++wGPUTextureFormat_R16Snorm :: WGPUTextureFormat+wGPUTextureFormat_R16Snorm = WGPUTextureFormat #const WGPUTextureFormat_R16Snorm++wGPUTextureFormat_R16Uint :: WGPUTextureFormat+wGPUTextureFormat_R16Uint = WGPUTextureFormat #const WGPUTextureFormat_R16Uint++wGPUTextureFormat_R16Sint :: WGPUTextureFormat+wGPUTextureFormat_R16Sint = WGPUTextureFormat #const WGPUTextureFormat_R16Sint++wGPUTextureFormat_R16Float :: WGPUTextureFormat+wGPUTextureFormat_R16Float = WGPUTextureFormat #const WGPUTextureFormat_R16Float++wGPUTextureFormat_RG8Unorm :: WGPUTextureFormat+wGPUTextureFormat_RG8Unorm = WGPUTextureFormat #const WGPUTextureFormat_RG8Unorm++wGPUTextureFormat_RG8Snorm :: WGPUTextureFormat+wGPUTextureFormat_RG8Snorm = WGPUTextureFormat #const WGPUTextureFormat_RG8Snorm++wGPUTextureFormat_RG8Uint :: WGPUTextureFormat+wGPUTextureFormat_RG8Uint = WGPUTextureFormat #const WGPUTextureFormat_RG8Uint++wGPUTextureFormat_RG8Sint :: WGPUTextureFormat+wGPUTextureFormat_RG8Sint = WGPUTextureFormat #const WGPUTextureFormat_RG8Sint++wGPUTextureFormat_R32Float :: WGPUTextureFormat+wGPUTextureFormat_R32Float = WGPUTextureFormat #const WGPUTextureFormat_R32Float++wGPUTextureFormat_R32Uint :: WGPUTextureFormat+wGPUTextureFormat_R32Uint = WGPUTextureFormat #const WGPUTextureFormat_R32Uint++wGPUTextureFormat_R32Sint :: WGPUTextureFormat+wGPUTextureFormat_R32Sint = WGPUTextureFormat #const WGPUTextureFormat_R32Sint++wGPUTextureFormat_RG16Unorm :: WGPUTextureFormat+wGPUTextureFormat_RG16Unorm = WGPUTextureFormat #const WGPUTextureFormat_RG16Unorm++wGPUTextureFormat_RG16Snorm :: WGPUTextureFormat+wGPUTextureFormat_RG16Snorm = WGPUTextureFormat #const WGPUTextureFormat_RG16Snorm++wGPUTextureFormat_RG16Uint :: WGPUTextureFormat+wGPUTextureFormat_RG16Uint = WGPUTextureFormat #const WGPUTextureFormat_RG16Uint++wGPUTextureFormat_RG16Sint :: WGPUTextureFormat+wGPUTextureFormat_RG16Sint = WGPUTextureFormat #const WGPUTextureFormat_RG16Sint++wGPUTextureFormat_RG16Float :: WGPUTextureFormat+wGPUTextureFormat_RG16Float = WGPUTextureFormat #const WGPUTextureFormat_RG16Float++wGPUTextureFormat_RGBA8Unorm :: WGPUTextureFormat+wGPUTextureFormat_RGBA8Unorm = WGPUTextureFormat #const WGPUTextureFormat_RGBA8Unorm++wGPUTextureFormat_RGBA8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_RGBA8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_RGBA8UnormSrgb++wGPUTextureFormat_RGBA8Snorm :: WGPUTextureFormat+wGPUTextureFormat_RGBA8Snorm = WGPUTextureFormat #const WGPUTextureFormat_RGBA8Snorm++wGPUTextureFormat_RGBA8Uint :: WGPUTextureFormat+wGPUTextureFormat_RGBA8Uint = WGPUTextureFormat #const WGPUTextureFormat_RGBA8Uint++wGPUTextureFormat_RGBA8Sint :: WGPUTextureFormat+wGPUTextureFormat_RGBA8Sint = WGPUTextureFormat #const WGPUTextureFormat_RGBA8Sint++wGPUTextureFormat_BGRA8Unorm :: WGPUTextureFormat+wGPUTextureFormat_BGRA8Unorm = WGPUTextureFormat #const WGPUTextureFormat_BGRA8Unorm++wGPUTextureFormat_BGRA8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_BGRA8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_BGRA8UnormSrgb++wGPUTextureFormat_RGB10A2Uint :: WGPUTextureFormat+wGPUTextureFormat_RGB10A2Uint = WGPUTextureFormat #const WGPUTextureFormat_RGB10A2Uint++wGPUTextureFormat_RGB10A2Unorm :: WGPUTextureFormat+wGPUTextureFormat_RGB10A2Unorm = WGPUTextureFormat #const WGPUTextureFormat_RGB10A2Unorm++wGPUTextureFormat_RG11B10Ufloat :: WGPUTextureFormat+wGPUTextureFormat_RG11B10Ufloat = WGPUTextureFormat #const WGPUTextureFormat_RG11B10Ufloat++wGPUTextureFormat_RGB9E5Ufloat :: WGPUTextureFormat+wGPUTextureFormat_RGB9E5Ufloat = WGPUTextureFormat #const WGPUTextureFormat_RGB9E5Ufloat++wGPUTextureFormat_RG32Float :: WGPUTextureFormat+wGPUTextureFormat_RG32Float = WGPUTextureFormat #const WGPUTextureFormat_RG32Float++wGPUTextureFormat_RG32Uint :: WGPUTextureFormat+wGPUTextureFormat_RG32Uint = WGPUTextureFormat #const WGPUTextureFormat_RG32Uint++wGPUTextureFormat_RG32Sint :: WGPUTextureFormat+wGPUTextureFormat_RG32Sint = WGPUTextureFormat #const WGPUTextureFormat_RG32Sint++wGPUTextureFormat_RGBA16Unorm :: WGPUTextureFormat+wGPUTextureFormat_RGBA16Unorm = WGPUTextureFormat #const WGPUTextureFormat_RGBA16Unorm++wGPUTextureFormat_RGBA16Snorm :: WGPUTextureFormat+wGPUTextureFormat_RGBA16Snorm = WGPUTextureFormat #const WGPUTextureFormat_RGBA16Snorm++wGPUTextureFormat_RGBA16Uint :: WGPUTextureFormat+wGPUTextureFormat_RGBA16Uint = WGPUTextureFormat #const WGPUTextureFormat_RGBA16Uint++wGPUTextureFormat_RGBA16Sint :: WGPUTextureFormat+wGPUTextureFormat_RGBA16Sint = WGPUTextureFormat #const WGPUTextureFormat_RGBA16Sint++wGPUTextureFormat_RGBA16Float :: WGPUTextureFormat+wGPUTextureFormat_RGBA16Float = WGPUTextureFormat #const WGPUTextureFormat_RGBA16Float++wGPUTextureFormat_RGBA32Float :: WGPUTextureFormat+wGPUTextureFormat_RGBA32Float = WGPUTextureFormat #const WGPUTextureFormat_RGBA32Float++wGPUTextureFormat_RGBA32Uint :: WGPUTextureFormat+wGPUTextureFormat_RGBA32Uint = WGPUTextureFormat #const WGPUTextureFormat_RGBA32Uint++wGPUTextureFormat_RGBA32Sint :: WGPUTextureFormat+wGPUTextureFormat_RGBA32Sint = WGPUTextureFormat #const WGPUTextureFormat_RGBA32Sint++wGPUTextureFormat_Stencil8 :: WGPUTextureFormat+wGPUTextureFormat_Stencil8 = WGPUTextureFormat #const WGPUTextureFormat_Stencil8++wGPUTextureFormat_Depth16Unorm :: WGPUTextureFormat+wGPUTextureFormat_Depth16Unorm = WGPUTextureFormat #const WGPUTextureFormat_Depth16Unorm++wGPUTextureFormat_Depth24Plus :: WGPUTextureFormat+wGPUTextureFormat_Depth24Plus = WGPUTextureFormat #const WGPUTextureFormat_Depth24Plus++wGPUTextureFormat_Depth24PlusStencil8 :: WGPUTextureFormat+wGPUTextureFormat_Depth24PlusStencil8 = WGPUTextureFormat #const WGPUTextureFormat_Depth24PlusStencil8++wGPUTextureFormat_Depth32Float :: WGPUTextureFormat+wGPUTextureFormat_Depth32Float = WGPUTextureFormat #const WGPUTextureFormat_Depth32Float++wGPUTextureFormat_Depth32FloatStencil8 :: WGPUTextureFormat+wGPUTextureFormat_Depth32FloatStencil8 = WGPUTextureFormat #const WGPUTextureFormat_Depth32FloatStencil8++wGPUTextureFormat_BC1RGBAUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC1RGBAUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC1RGBAUnorm++wGPUTextureFormat_BC1RGBAUnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_BC1RGBAUnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_BC1RGBAUnormSrgb++wGPUTextureFormat_BC2RGBAUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC2RGBAUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC2RGBAUnorm++wGPUTextureFormat_BC2RGBAUnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_BC2RGBAUnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_BC2RGBAUnormSrgb++wGPUTextureFormat_BC3RGBAUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC3RGBAUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC3RGBAUnorm++wGPUTextureFormat_BC3RGBAUnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_BC3RGBAUnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_BC3RGBAUnormSrgb++wGPUTextureFormat_BC4RUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC4RUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC4RUnorm++wGPUTextureFormat_BC4RSnorm :: WGPUTextureFormat+wGPUTextureFormat_BC4RSnorm = WGPUTextureFormat #const WGPUTextureFormat_BC4RSnorm++wGPUTextureFormat_BC5RGUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC5RGUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC5RGUnorm++wGPUTextureFormat_BC5RGSnorm :: WGPUTextureFormat+wGPUTextureFormat_BC5RGSnorm = WGPUTextureFormat #const WGPUTextureFormat_BC5RGSnorm++wGPUTextureFormat_BC6HRGBUfloat :: WGPUTextureFormat+wGPUTextureFormat_BC6HRGBUfloat = WGPUTextureFormat #const WGPUTextureFormat_BC6HRGBUfloat++wGPUTextureFormat_BC6HRGBFloat :: WGPUTextureFormat+wGPUTextureFormat_BC6HRGBFloat = WGPUTextureFormat #const WGPUTextureFormat_BC6HRGBFloat++wGPUTextureFormat_BC7RGBAUnorm :: WGPUTextureFormat+wGPUTextureFormat_BC7RGBAUnorm = WGPUTextureFormat #const WGPUTextureFormat_BC7RGBAUnorm++wGPUTextureFormat_BC7RGBAUnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_BC7RGBAUnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_BC7RGBAUnormSrgb++wGPUTextureFormat_ETC2RGB8Unorm :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGB8Unorm = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGB8Unorm++wGPUTextureFormat_ETC2RGB8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGB8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGB8UnormSrgb++wGPUTextureFormat_ETC2RGB8A1Unorm :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGB8A1Unorm = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGB8A1Unorm++wGPUTextureFormat_ETC2RGB8A1UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGB8A1UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGB8A1UnormSrgb++wGPUTextureFormat_ETC2RGBA8Unorm :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGBA8Unorm = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGBA8Unorm++wGPUTextureFormat_ETC2RGBA8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ETC2RGBA8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ETC2RGBA8UnormSrgb++wGPUTextureFormat_EACR11Unorm :: WGPUTextureFormat+wGPUTextureFormat_EACR11Unorm = WGPUTextureFormat #const WGPUTextureFormat_EACR11Unorm++wGPUTextureFormat_EACR11Snorm :: WGPUTextureFormat+wGPUTextureFormat_EACR11Snorm = WGPUTextureFormat #const WGPUTextureFormat_EACR11Snorm++wGPUTextureFormat_EACRG11Unorm :: WGPUTextureFormat+wGPUTextureFormat_EACRG11Unorm = WGPUTextureFormat #const WGPUTextureFormat_EACRG11Unorm++wGPUTextureFormat_EACRG11Snorm :: WGPUTextureFormat+wGPUTextureFormat_EACRG11Snorm = WGPUTextureFormat #const WGPUTextureFormat_EACRG11Snorm++wGPUTextureFormat_ASTC4x4Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC4x4Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC4x4Unorm++wGPUTextureFormat_ASTC4x4UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC4x4UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC4x4UnormSrgb++wGPUTextureFormat_ASTC5x4Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC5x4Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC5x4Unorm++wGPUTextureFormat_ASTC5x4UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC5x4UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC5x4UnormSrgb++wGPUTextureFormat_ASTC5x5Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC5x5Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC5x5Unorm++wGPUTextureFormat_ASTC5x5UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC5x5UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC5x5UnormSrgb++wGPUTextureFormat_ASTC6x5Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC6x5Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC6x5Unorm++wGPUTextureFormat_ASTC6x5UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC6x5UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC6x5UnormSrgb++wGPUTextureFormat_ASTC6x6Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC6x6Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC6x6Unorm++wGPUTextureFormat_ASTC6x6UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC6x6UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC6x6UnormSrgb++wGPUTextureFormat_ASTC8x5Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x5Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x5Unorm++wGPUTextureFormat_ASTC8x5UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x5UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x5UnormSrgb++wGPUTextureFormat_ASTC8x6Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x6Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x6Unorm++wGPUTextureFormat_ASTC8x6UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x6UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x6UnormSrgb++wGPUTextureFormat_ASTC8x8Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x8Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x8Unorm++wGPUTextureFormat_ASTC8x8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC8x8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC8x8UnormSrgb++wGPUTextureFormat_ASTC10x5Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x5Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x5Unorm++wGPUTextureFormat_ASTC10x5UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x5UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x5UnormSrgb++wGPUTextureFormat_ASTC10x6Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x6Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x6Unorm++wGPUTextureFormat_ASTC10x6UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x6UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x6UnormSrgb++wGPUTextureFormat_ASTC10x8Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x8Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x8Unorm++wGPUTextureFormat_ASTC10x8UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x8UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x8UnormSrgb++wGPUTextureFormat_ASTC10x10Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x10Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x10Unorm++wGPUTextureFormat_ASTC10x10UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC10x10UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC10x10UnormSrgb++wGPUTextureFormat_ASTC12x10Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC12x10Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC12x10Unorm++wGPUTextureFormat_ASTC12x10UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC12x10UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC12x10UnormSrgb++wGPUTextureFormat_ASTC12x12Unorm :: WGPUTextureFormat+wGPUTextureFormat_ASTC12x12Unorm = WGPUTextureFormat #const WGPUTextureFormat_ASTC12x12Unorm++wGPUTextureFormat_ASTC12x12UnormSrgb :: WGPUTextureFormat+wGPUTextureFormat_ASTC12x12UnormSrgb = WGPUTextureFormat #const WGPUTextureFormat_ASTC12x12UnormSrgb++wGPUTextureFormat_Force32 :: WGPUTextureFormat+wGPUTextureFormat_Force32 = WGPUTextureFormat #const WGPUTextureFormat_Force32++newtype WGPUTextureUsage = WGPUTextureUsage WGPUFlags deriving newtype (Show, Eq, Storable, Num, Bits)++wGPUTextureUsage_None :: WGPUTextureUsage+wGPUTextureUsage_None =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_None++wGPUTextureUsage_CopySrc :: WGPUTextureUsage+wGPUTextureUsage_CopySrc =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_CopySrc++wGPUTextureUsage_CopyDst :: WGPUTextureUsage+wGPUTextureUsage_CopyDst =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_CopyDst++wGPUTextureUsage_TextureBinding :: WGPUTextureUsage+wGPUTextureUsage_TextureBinding =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_TextureBinding++wGPUTextureUsage_StorageBinding :: WGPUTextureUsage+wGPUTextureUsage_StorageBinding =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_StorageBinding++wGPUTextureUsage_RenderAttachment :: WGPUTextureUsage+wGPUTextureUsage_RenderAttachment =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_RenderAttachment++wGPUTextureUsage_TransientAttachment :: WGPUTextureUsage+wGPUTextureUsage_TransientAttachment =  WGPUTextureUsage $ WGPUFlags #const WGPUTextureUsage_TransientAttachment+++newtype WGPUPresentMode = WGPUPresentMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUPresentMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUPresentMode x+  poke ptr (WGPUPresentMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUPresentMode_Undefined :: WGPUPresentMode+wGPUPresentMode_Undefined = WGPUPresentMode #const WGPUPresentMode_Undefined++wGPUPresentMode_Fifo :: WGPUPresentMode+wGPUPresentMode_Fifo = WGPUPresentMode #const WGPUPresentMode_Fifo++wGPUPresentMode_FifoRelaxed :: WGPUPresentMode+wGPUPresentMode_FifoRelaxed = WGPUPresentMode #const WGPUPresentMode_FifoRelaxed++wGPUPresentMode_Immediate :: WGPUPresentMode+wGPUPresentMode_Immediate = WGPUPresentMode #const WGPUPresentMode_Immediate++wGPUPresentMode_Mailbox :: WGPUPresentMode+wGPUPresentMode_Mailbox = WGPUPresentMode #const WGPUPresentMode_Mailbox++wGPUPresentMode_Force32 :: WGPUPresentMode+wGPUPresentMode_Force32 = WGPUPresentMode #const WGPUPresentMode_Force32+++newtype WGPUCompositeAlphaMode = WGPUCompositeAlphaMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUCompositeAlphaMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUCompositeAlphaMode x+  poke ptr (WGPUCompositeAlphaMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUCompositeAlphaMode_Auto :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Auto = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Auto++wGPUCompositeAlphaMode_Opaque :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Opaque = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Opaque++wGPUCompositeAlphaMode_Premultiplied :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Premultiplied = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Premultiplied++wGPUCompositeAlphaMode_Unpremultiplied :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Unpremultiplied = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Unpremultiplied++wGPUCompositeAlphaMode_Inherit :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Inherit = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Inherit++wGPUCompositeAlphaMode_Force32 :: WGPUCompositeAlphaMode+wGPUCompositeAlphaMode_Force32 = WGPUCompositeAlphaMode #const WGPUCompositeAlphaMode_Force32++newtype WGPUPrimitiveTopology = WGPUPrimitiveTopology CUInt deriving (Eq, Ord, Show)++instance Storable WGPUPrimitiveTopology where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUPrimitiveTopology x+  poke ptr (WGPUPrimitiveTopology x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUPrimitiveTopology_Undefined :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_Undefined = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_Undefined++wGPUPrimitiveTopology_PointList :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_PointList = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_PointList++wGPUPrimitiveTopology_LineList :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_LineList = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_LineList++wGPUPrimitiveTopology_LineStrip :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_LineStrip = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_LineStrip++wGPUPrimitiveTopology_TriangleList :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_TriangleList = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_TriangleList++wGPUPrimitiveTopology_TriangleStrip :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_TriangleStrip = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_TriangleStrip++wGPUPrimitiveTopology_Force32 :: WGPUPrimitiveTopology+wGPUPrimitiveTopology_Force32 = WGPUPrimitiveTopology #const WGPUPrimitiveTopology_Force32++newtype WGPUIndexFormat = WGPUIndexFormat CUInt deriving (Eq, Ord, Show)++instance Storable WGPUIndexFormat where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUIndexFormat x+  poke ptr (WGPUIndexFormat x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUIndexFormat_Undefined :: WGPUIndexFormat+wGPUIndexFormat_Undefined = WGPUIndexFormat #const WGPUIndexFormat_Undefined++wGPUIndexFormat_Uint16 :: WGPUIndexFormat+wGPUIndexFormat_Uint16 = WGPUIndexFormat #const WGPUIndexFormat_Uint16++wGPUIndexFormat_Uint32 :: WGPUIndexFormat+wGPUIndexFormat_Uint32 = WGPUIndexFormat #const WGPUIndexFormat_Uint32++wGPUIndexFormat_Force32 :: WGPUIndexFormat+wGPUIndexFormat_Force32 = WGPUIndexFormat #const WGPUIndexFormat_Force32+newtype WGPUFrontFace = WGPUFrontFace CUInt deriving (Eq, Ord, Show)++instance Storable WGPUFrontFace where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUFrontFace x+  poke ptr (WGPUFrontFace x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUFrontFace_Undefined :: WGPUFrontFace+wGPUFrontFace_Undefined = WGPUFrontFace #const WGPUFrontFace_Undefined++wGPUFrontFace_CCW :: WGPUFrontFace+wGPUFrontFace_CCW = WGPUFrontFace #const WGPUFrontFace_CCW++wGPUFrontFace_CW :: WGPUFrontFace+wGPUFrontFace_CW = WGPUFrontFace #const WGPUFrontFace_CW++wGPUFrontFace_Force32 :: WGPUFrontFace+wGPUFrontFace_Force32 = WGPUFrontFace #const WGPUFrontFace_Force32+++newtype WGPUCullMode = WGPUCullMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUCullMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUCullMode x+  poke ptr (WGPUCullMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUCullMode_Undefined :: WGPUCullMode+wGPUCullMode_Undefined = WGPUCullMode #const WGPUCullMode_Undefined++wGPUCullMode_None :: WGPUCullMode+wGPUCullMode_None = WGPUCullMode #const WGPUCullMode_None++wGPUCullMode_Front :: WGPUCullMode+wGPUCullMode_Front = WGPUCullMode #const WGPUCullMode_Front++wGPUCullMode_Back :: WGPUCullMode+wGPUCullMode_Back = WGPUCullMode #const WGPUCullMode_Back++wGPUCullMode_Force32 :: WGPUCullMode+wGPUCullMode_Force32 = WGPUCullMode #const WGPUCullMode_Force32++newtype WGPUColorWriteMask = WGPUColorWriteMask WGPUFlags deriving newtype (Show, Eq, Storable, Num)++wGPUColorWriteMask_None :: WGPUColorWriteMask+wGPUColorWriteMask_None = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_None++wGPUColorWriteMask_Red :: WGPUColorWriteMask+wGPUColorWriteMask_Red = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_Red++wGPUColorWriteMask_Green :: WGPUColorWriteMask+wGPUColorWriteMask_Green = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_Green++wGPUColorWriteMask_Blue :: WGPUColorWriteMask+wGPUColorWriteMask_Blue = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_Blue++wGPUColorWriteMask_Alpha :: WGPUColorWriteMask+wGPUColorWriteMask_Alpha = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_Alpha++wGPUColorWriteMask_All :: WGPUColorWriteMask+wGPUColorWriteMask_All = WGPUColorWriteMask $ WGPUFlags #const WGPUColorWriteMask_All++newtype WGPUSurfaceGetCurrentTextureStatus = WGPUSurfaceGetCurrentTextureStatus CUInt deriving (Eq, Ord, Show)++instance Storable WGPUSurfaceGetCurrentTextureStatus where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUSurfaceGetCurrentTextureStatus x+  poke ptr (WGPUSurfaceGetCurrentTextureStatus x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUSurfaceGetCurrentTextureStatus_SuccessOptimal :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_SuccessOptimal = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_SuccessOptimal++wGPUSurfaceGetCurrentTextureStatus_SuccessSuboptimal :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_SuccessSuboptimal = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_SuccessSuboptimal++wGPUSurfaceGetCurrentTextureStatus_Timeout :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_Timeout = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_Timeout++wGPUSurfaceGetCurrentTextureStatus_Outdated :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_Outdated = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_Outdated++wGPUSurfaceGetCurrentTextureStatus_Lost :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_Lost = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_Lost++wGPUSurfaceGetCurrentTextureStatus_Error :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_Error = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_Error++wGPUSurfaceGetCurrentTextureStatus_Force32 :: WGPUSurfaceGetCurrentTextureStatus+wGPUSurfaceGetCurrentTextureStatus_Force32 = WGPUSurfaceGetCurrentTextureStatus #const WGPUSurfaceGetCurrentTextureStatus_Force32+++newtype WGPULoadOp = WGPULoadOp CUInt deriving (Eq, Ord, Show)++instance Storable WGPULoadOp where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPULoadOp x+  poke ptr (WGPULoadOp x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPULoadOp_Undefined :: WGPULoadOp+wGPULoadOp_Undefined = WGPULoadOp #const WGPULoadOp_Undefined++wGPULoadOp_Load :: WGPULoadOp+wGPULoadOp_Load = WGPULoadOp #const WGPULoadOp_Load++wGPULoadOp_Clear :: WGPULoadOp+wGPULoadOp_Clear = WGPULoadOp #const WGPULoadOp_Clear++wGPULoadOp_Force32 :: WGPULoadOp+wGPULoadOp_Force32 = WGPULoadOp #const WGPULoadOp_Force32+++newtype WGPUStoreOp = WGPUStoreOp CUInt deriving (Eq, Ord, Show)++instance Storable WGPUStoreOp where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUStoreOp x+  poke ptr (WGPUStoreOp x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUStoreOp_Undefined :: WGPUStoreOp+wGPUStoreOp_Undefined = WGPUStoreOp #const WGPUStoreOp_Undefined++wGPUStoreOp_Store :: WGPUStoreOp+wGPUStoreOp_Store = WGPUStoreOp #const WGPUStoreOp_Store++wGPUStoreOp_Discard :: WGPUStoreOp+wGPUStoreOp_Discard = WGPUStoreOp #const WGPUStoreOp_Discard++wGPUStoreOp_Force32 :: WGPUStoreOp+wGPUStoreOp_Force32 = WGPUStoreOp #const WGPUStoreOp_Force32+++newtype WGPUTextureAspect = WGPUTextureAspect CUInt deriving (Eq, Ord, Show)++instance Storable WGPUTextureAspect where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUTextureAspect x+  poke ptr (WGPUTextureAspect x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUTextureAspect_Undefined :: WGPUTextureAspect+wGPUTextureAspect_Undefined = WGPUTextureAspect #const WGPUTextureAspect_Undefined++wGPUTextureAspect_All :: WGPUTextureAspect+wGPUTextureAspect_All = WGPUTextureAspect #const WGPUTextureAspect_All++wGPUTextureAspect_StencilOnly :: WGPUTextureAspect+wGPUTextureAspect_StencilOnly = WGPUTextureAspect #const WGPUTextureAspect_StencilOnly++wGPUTextureAspect_DepthOnly :: WGPUTextureAspect+wGPUTextureAspect_DepthOnly = WGPUTextureAspect #const WGPUTextureAspect_DepthOnly++wGPUTextureAspect_Force32 :: WGPUTextureAspect+wGPUTextureAspect_Force32 = WGPUTextureAspect #const WGPUTextureAspect_Force32+++newtype WGPUTextureDimension = WGPUTextureDimension CUInt deriving (Eq, Ord, Show)++instance Storable WGPUTextureDimension where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUTextureDimension x+  poke ptr (WGPUTextureDimension x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUTextureDimension_Undefined :: WGPUTextureDimension+wGPUTextureDimension_Undefined = WGPUTextureDimension #const WGPUTextureDimension_Undefined++wGPUTextureDimension_1D :: WGPUTextureDimension+wGPUTextureDimension_1D = WGPUTextureDimension #const WGPUTextureDimension_1D++wGPUTextureDimension_2D :: WGPUTextureDimension+wGPUTextureDimension_2D = WGPUTextureDimension #const WGPUTextureDimension_2D++wGPUTextureDimension_3D :: WGPUTextureDimension+wGPUTextureDimension_3D = WGPUTextureDimension #const WGPUTextureDimension_3D++wGPUTextureDimension_Force32 :: WGPUTextureDimension+wGPUTextureDimension_Force32 = WGPUTextureDimension #const WGPUTextureDimension_Force32+++newtype WGPUAddressMode = WGPUAddressMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUAddressMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUAddressMode x+  poke ptr (WGPUAddressMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUAddressMode_Undefined :: WGPUAddressMode+wGPUAddressMode_Undefined = WGPUAddressMode #const WGPUAddressMode_Undefined++wGPUAddressMode_ClampToEdge :: WGPUAddressMode+wGPUAddressMode_ClampToEdge = WGPUAddressMode #const WGPUAddressMode_ClampToEdge++wGPUAddressMode_Repeat :: WGPUAddressMode+wGPUAddressMode_Repeat = WGPUAddressMode #const WGPUAddressMode_Repeat++wGPUAddressMode_MirrorRepeat :: WGPUAddressMode+wGPUAddressMode_MirrorRepeat = WGPUAddressMode #const WGPUAddressMode_MirrorRepeat++wGPUAddressMode_Force32 :: WGPUAddressMode+wGPUAddressMode_Force32 = WGPUAddressMode #const WGPUAddressMode_Force32+++newtype WGPUFilterMode = WGPUFilterMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUFilterMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUFilterMode x+  poke ptr (WGPUFilterMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUFilterMode_Undefined :: WGPUFilterMode+wGPUFilterMode_Undefined = WGPUFilterMode #const WGPUFilterMode_Undefined++wGPUFilterMode_Nearest :: WGPUFilterMode+wGPUFilterMode_Nearest = WGPUFilterMode #const WGPUFilterMode_Nearest++wGPUFilterMode_Linear :: WGPUFilterMode+wGPUFilterMode_Linear = WGPUFilterMode #const WGPUFilterMode_Linear++wGPUFilterMode_Force32 :: WGPUFilterMode+wGPUFilterMode_Force32 = WGPUFilterMode #const WGPUFilterMode_Force32+++newtype WGPUMipmapFilterMode = WGPUMipmapFilterMode CUInt deriving (Eq, Ord, Show)++instance Storable WGPUMipmapFilterMode where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUMipmapFilterMode x+  poke ptr (WGPUMipmapFilterMode x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUMipmapFilterMode_Undefined :: WGPUMipmapFilterMode+wGPUMipmapFilterMode_Undefined = WGPUMipmapFilterMode #const WGPUMipmapFilterMode_Undefined++wGPUMipmapFilterMode_Nearest :: WGPUMipmapFilterMode+wGPUMipmapFilterMode_Nearest = WGPUMipmapFilterMode #const WGPUMipmapFilterMode_Nearest++wGPUMipmapFilterMode_Linear :: WGPUMipmapFilterMode+wGPUMipmapFilterMode_Linear = WGPUMipmapFilterMode #const WGPUMipmapFilterMode_Linear++wGPUMipmapFilterMode_Force32 :: WGPUMipmapFilterMode+wGPUMipmapFilterMode_Force32 = WGPUMipmapFilterMode #const WGPUMipmapFilterMode_Force32+++newtype WGPUCompareFunction = WGPUCompareFunction CUInt deriving (Eq, Ord, Show)++instance Storable WGPUCompareFunction where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUCompareFunction x+  poke ptr (WGPUCompareFunction x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUCompareFunction_Undefined :: WGPUCompareFunction+wGPUCompareFunction_Undefined = WGPUCompareFunction #const WGPUCompareFunction_Undefined++wGPUCompareFunction_Never :: WGPUCompareFunction+wGPUCompareFunction_Never = WGPUCompareFunction #const WGPUCompareFunction_Never++wGPUCompareFunction_Less :: WGPUCompareFunction+wGPUCompareFunction_Less = WGPUCompareFunction #const WGPUCompareFunction_Less++wGPUCompareFunction_Equal :: WGPUCompareFunction+wGPUCompareFunction_Equal = WGPUCompareFunction #const WGPUCompareFunction_Equal++wGPUCompareFunction_LessEqual :: WGPUCompareFunction+wGPUCompareFunction_LessEqual = WGPUCompareFunction #const WGPUCompareFunction_LessEqual++wGPUCompareFunction_Greater :: WGPUCompareFunction+wGPUCompareFunction_Greater = WGPUCompareFunction #const WGPUCompareFunction_Greater++wGPUCompareFunction_NotEqual :: WGPUCompareFunction+wGPUCompareFunction_NotEqual = WGPUCompareFunction #const WGPUCompareFunction_NotEqual++wGPUCompareFunction_GreaterEqual :: WGPUCompareFunction+wGPUCompareFunction_GreaterEqual = WGPUCompareFunction #const WGPUCompareFunction_GreaterEqual++wGPUCompareFunction_Always :: WGPUCompareFunction+wGPUCompareFunction_Always = WGPUCompareFunction #const WGPUCompareFunction_Always++wGPUCompareFunction_Force32 :: WGPUCompareFunction+wGPUCompareFunction_Force32 = WGPUCompareFunction #const WGPUCompareFunction_Force32+++newtype WGPUSamplerBindingType = WGPUSamplerBindingType CUInt deriving (Eq, Ord, Show)++instance Storable WGPUSamplerBindingType where+  alignment _ = alignment (undefined :: CUInt)+  sizeOf _ = sizeOf (undefined :: CUInt)+  peek ptr = do+    x <- peek (castPtr ptr)+    pure $ WGPUSamplerBindingType x+  poke ptr (WGPUSamplerBindingType x) = do+    let a :: Ptr CUInt = castPtr ptr+    poke a x++wGPUSamplerBindingType_BindingNotUsed :: WGPUSamplerBindingType+wGPUSamplerBindingType_BindingNotUsed = WGPUSamplerBindingType #const WGPUSamplerBindingType_BindingNotUsed++wGPUSamplerBindingType_Undefined :: WGPUSamplerBindingType+wGPUSamplerBindingType_Undefined = WGPUSamplerBindingType #const WGPUSamplerBindingType_Undefined++wGPUSamplerBindingType_Filtering :: WGPUSamplerBindingType+wGPUSamplerBindingType_Filtering = WGPUSamplerBindingType #const WGPUSamplerBindingType_Filtering++wGPUSamplerBindingType_NonFiltering :: WGPUSamplerBindingType+wGPUSamplerBindingType_NonFiltering = WGPUSamplerBindingType #const WGPUSamplerBindingType_NonFiltering++wGPUSamplerBindingType_Comparison :: WGPUSamplerBindingType+wGPUSamplerBindingType_Comparison = WGPUSamplerBindingType #const WGPUSamplerBindingType_Comparison++wGPUSamplerBindingType_Force32 :: WGPUSamplerBindingType+wGPUSamplerBindingType_Force32 = WGPUSamplerBindingType #const WGPUSamplerBindingType_Force32
+ src/Mischief/WGPU/Types/General.hsc view
@@ -0,0 +1,1164 @@+#include "webgpu.h"++module Mischief.WGPU.Types.General where ++import Foreign +import Foreign.C.ConstPtr+import Foreign.C.Types+import Data.Void++import Mischief.WGPU.Callbacks+import Mischief.WGPU.Types.Enums+++import Data.Data(Proxy(Proxy))+import Mischief.WGPU.Opaque+++data WGPUSurface = WGPUSurface++data WGPUChainedStruct = WGPUChainedStruct+  { next :: Ptr WGPUChainedStruct,+    sType :: WGPUSType+  }+  ++instance Storable WGPUChainedStruct where +  alignment _ = #{alignment WGPUChainedStruct}+  sizeOf _ = #{size WGPUChainedStruct}+  peek ptr = do +    next <- #{peek WGPUChainedStruct, next} ptr +    sType <- #{peek WGPUChainedStruct, sType} ptr +    return WGPUChainedStruct {next, sType}+  poke ptr WGPUChainedStruct {next, sType} = do +    #{poke WGPUChainedStruct, next} ptr next+    #{poke WGPUChainedStruct, sType} ptr sType  +++data WGPUSurfaceSourceXlibWindow = WGPUSurfaceSourceXlibWindow { +  chain :: WGPUChainedStruct,+  display :: Ptr Void,+  window :: Int64+}++instance Storable WGPUSurfaceSourceXlibWindow where +  alignment _ = #{alignment WGPUSurfaceSourceXlibWindow}+  sizeOf _ = #{size WGPUSurfaceSourceXlibWindow}+  peek ptr = do +    chain <- #{peek WGPUSurfaceSourceXlibWindow, chain} ptr +    display <- #{peek WGPUSurfaceSourceXlibWindow, display} ptr +    window <- #{peek WGPUSurfaceSourceXlibWindow, window} ptr +    return WGPUSurfaceSourceXlibWindow {chain, display, window}+  poke ptr WGPUSurfaceSourceXlibWindow {chain, display, window} = do +    #{poke WGPUSurfaceSourceXlibWindow, chain} ptr chain+    #{poke WGPUSurfaceSourceXlibWindow, display} ptr display+    #{poke WGPUSurfaceSourceXlibWindow, window} ptr window++data WGPUSurfaceSourceWindowsHWND = WGPUSurfaceSourceWindowsHWND {+  chain :: WGPUChainedStruct, +  hinstance :: Ptr Void,+  hwnd :: Ptr Void  +}++instance Storable WGPUSurfaceSourceWindowsHWND where+  alignment _ = #{alignment WGPUSurfaceSourceWindowsHWND}+  sizeOf _ = #{size WGPUSurfaceSourceWindowsHWND}+  peek ptr = do+    chain <- #{peek WGPUSurfaceSourceWindowsHWND, chain} ptr+    hinstance <- #{peek WGPUSurfaceSourceWindowsHWND, hinstance} ptr+    hwnd <- #{peek WGPUSurfaceSourceWindowsHWND, hwnd} ptr+    return WGPUSurfaceSourceWindowsHWND{chain, hinstance, hwnd}+  poke ptr WGPUSurfaceSourceWindowsHWND{chain, hinstance, hwnd} = do+    #{poke WGPUSurfaceSourceWindowsHWND, chain} ptr chain+    #{poke WGPUSurfaceSourceWindowsHWND, hinstance} ptr hinstance+    #{poke WGPUSurfaceSourceWindowsHWND, hwnd} ptr hwnd+++data WGPUSurfaceSourceMetalLayer = WGPUSurfaceSourceMetalLayer {+  chain :: WGPUChainedStruct, +  layer :: Ptr Void +}++instance Storable WGPUSurfaceSourceMetalLayer where +  alignment _ = #{alignment WGPUSurfaceSourceMetalLayer}+  sizeOf _ = #{size WGPUSurfaceSourceMetalLayer}+  peek ptr = do +    chain <- #{peek WGPUSurfaceSourceMetalLayer, chain} ptr +    layer <- #{peek WGPUSurfaceSourceMetalLayer, layer} ptr +    return WGPUSurfaceSourceMetalLayer {chain, layer} +  poke ptr WGPUSurfaceSourceMetalLayer {chain, layer} = do +    #{poke WGPUSurfaceSourceMetalLayer, chain} ptr chain +    #{poke WGPUSurfaceSourceMetalLayer, layer} ptr layer++data WGPUStringView = WGPUStringView {+  _data :: ConstPtr CChar, +  length :: Int +}++instance Storable WGPUStringView where +  alignment _ = #{alignment WGPUStringView}+  sizeOf _ = #{size WGPUStringView}+  peek ptr = do +    _data <- #{peek WGPUStringView, data} ptr +    length <- #{peek WGPUStringView, length} ptr +    return WGPUStringView {_data, length} +  poke ptr WGPUStringView {_data, length} = do +    #{poke WGPUStringView, data} ptr _data+    #{poke WGPUStringView, length} ptr length+  +data WGPUSurfaceDescriptor = WGPUSurfaceDescriptor {+  nextInChain :: Ptr WGPUChainedStruct,+  label :: WGPUStringView +}++instance Storable WGPUSurfaceDescriptor where +  alignment _ = #{alignment WGPUSurfaceDescriptor}+  sizeOf _ = #{size WGPUSurfaceDescriptor}+  peek ptr = do +    nextInChain <- #{peek WGPUSurfaceDescriptor, nextInChain} ptr +    label <- #{peek WGPUSurfaceDescriptor, label} ptr +    return WGPUSurfaceDescriptor {nextInChain, label}+  poke ptr WGPUSurfaceDescriptor {nextInChain, label} = do+    #{poke WGPUSurfaceDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUSurfaceDescriptor, label} ptr label +++data WGPURequestAdapterOptions = WGPURequestAdapterOptions {+  nextInChain :: Ptr WGPUChainedStruct, +  featureLevel :: WGPUFeatureLevel, +  powerPreference :: WGPUPowerPreference, +  forceFallbackAdapter :: WGPUBool,+  backendType :: WGPUBackendType, +  compatibleSurface :: Ptr WGPUSurface +}++instance Storable WGPURequestAdapterOptions where +  alignment _ = #{alignment WGPURequestAdapterOptions}+  sizeOf _ = #{size WGPURequestAdapterOptions}+  peek ptr = do +    nextInChain <- #{peek WGPURequestAdapterOptions, nextInChain} ptr +    featureLevel <- #{peek WGPURequestAdapterOptions, featureLevel} ptr +    powerPreference <- #{peek WGPURequestAdapterOptions, powerPreference} ptr +    forceFallbackAdapter <- #{peek WGPURequestAdapterOptions, forceFallbackAdapter} ptr +    backendType <- #{peek WGPURequestAdapterOptions, backendType} ptr +    compatibleSurface <- #{peek WGPURequestAdapterOptions, compatibleSurface} ptr +    return WGPURequestAdapterOptions {nextInChain, featureLevel, powerPreference, forceFallbackAdapter, backendType, compatibleSurface}+  poke ptr WGPURequestAdapterOptions {nextInChain, featureLevel, powerPreference, forceFallbackAdapter, backendType, compatibleSurface} = do+    #{poke WGPURequestAdapterOptions, nextInChain} ptr nextInChain +    #{poke WGPURequestAdapterOptions, featureLevel} ptr featureLevel +    #{poke WGPURequestAdapterOptions, powerPreference} ptr powerPreference +    #{poke WGPURequestAdapterOptions, forceFallbackAdapter} ptr forceFallbackAdapter +    #{poke WGPURequestAdapterOptions, backendType} ptr backendType +    #{poke WGPURequestAdapterOptions, compatibleSurface} ptr compatibleSurface+++data WGPURequestCallbackInfo f = WGPURequestCallbackInfo {+  nextInChain :: Ptr WGPUChainedStruct, +  mode :: WGPUCallbackMode, +  callback :: FunPtr f, +  userdata1 :: Ptr (), +  userdata2 :: Ptr ()+}++instance Storable (WGPURequestCallbackInfo WGPURequestAdapterCallback) where +  alignment _ = #{alignment WGPURequestAdapterCallbackInfo}+  sizeOf _ = #{size WGPURequestAdapterCallbackInfo}+  peek ptr = do +    nextInChain <- #{peek WGPURequestAdapterCallbackInfo, nextInChain} ptr +    mode <- #{peek WGPURequestAdapterCallbackInfo, mode} ptr +    callback <- #{peek WGPURequestAdapterCallbackInfo, callback} ptr +    userdata1 <- #{peek WGPURequestAdapterCallbackInfo, userdata1} ptr +    userdata2 <- #{peek WGPURequestAdapterCallbackInfo, userdata2} ptr +    return WGPURequestCallbackInfo {nextInChain, mode, callback, userdata1, userdata2}+  poke ptr WGPURequestCallbackInfo {nextInChain, mode, callback, userdata1, userdata2} = do +    #{poke WGPURequestAdapterCallbackInfo, nextInChain} ptr nextInChain+    #{poke WGPURequestAdapterCallbackInfo, mode} ptr mode  +    #{poke WGPURequestAdapterCallbackInfo, callback} ptr callback  +    #{poke WGPURequestAdapterCallbackInfo, userdata1} ptr userdata1  +    #{poke WGPURequestAdapterCallbackInfo, userdata2} ptr userdata2  +++instance Storable (WGPURequestCallbackInfo WGPURequestDeviceCallback) where +  alignment _ = #{alignment WGPURequestDeviceCallbackInfo}+  sizeOf _ = #{size WGPURequestDeviceCallbackInfo}+  peek ptr = do +    nextInChain <- #{peek WGPURequestDeviceCallbackInfo, nextInChain} ptr +    mode <- #{peek WGPURequestDeviceCallbackInfo, mode} ptr +    callback <- #{peek WGPURequestDeviceCallbackInfo, callback} ptr +    userdata1 <- #{peek WGPURequestDeviceCallbackInfo, userdata1} ptr +    userdata2 <- #{peek WGPURequestDeviceCallbackInfo, userdata2} ptr +    return WGPURequestCallbackInfo {nextInChain, mode, callback, userdata1, userdata2}+  poke ptr WGPURequestCallbackInfo {nextInChain, mode, callback, userdata1, userdata2} = do +    #{poke WGPURequestDeviceCallbackInfo, nextInChain} ptr nextInChain+    #{poke WGPURequestDeviceCallbackInfo, mode} ptr mode  +    #{poke WGPURequestDeviceCallbackInfo, callback} ptr callback  +    #{poke WGPURequestDeviceCallbackInfo, userdata1} ptr userdata1  +    #{poke WGPURequestDeviceCallbackInfo, userdata2} ptr userdata2  ++data WGPUShaderSourceWGSL = WGPUShaderSourceWGSL {+  chain :: WGPUChainedStruct, +  code :: WGPUStringView+}++instance Storable WGPUShaderSourceWGSL where +  alignment _ = #{alignment WGPUShaderSourceWGSL}+  sizeOf _ = #{size WGPUShaderSourceWGSL}+  peek ptr = do +    chain <- #{peek WGPUShaderSourceWGSL, chain} ptr +    code <- #{peek WGPUShaderSourceWGSL, code} ptr +    return WGPUShaderSourceWGSL {chain, code}+  poke ptr WGPUShaderSourceWGSL {chain, code} = do +    #{poke WGPUShaderSourceWGSL, chain} ptr chain +    #{poke WGPUShaderSourceWGSL, code} ptr code ++data WGPUShaderModuleDescriptor = WGPUShaderModuleDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView+}++instance Storable WGPUShaderModuleDescriptor where +  alignment _ = #{alignment WGPUShaderModuleDescriptor}+  sizeOf _ = #{size WGPUShaderModuleDescriptor}+  peek ptr = do +    nextInChain <- #{peek WGPUShaderModuleDescriptor, nextInChain} ptr +    label <- #{peek WGPUShaderModuleDescriptor, label} ptr +    return WGPUShaderModuleDescriptor {nextInChain, label}+  poke ptr WGPUShaderModuleDescriptor {nextInChain, label} = do +    #{poke WGPUShaderModuleDescriptor, nextInChain} ptr nextInChain +    #{poke WGPUShaderModuleDescriptor, label} ptr label ++data WGPUSurfaceCapabilities = WGPUSurfaceCapabilities {+  nextInChain :: Ptr WGPUChainedStruct, +  usages :: WGPUTextureUsage, +  formatCount :: Int,+  formats :: ConstPtr WGPUTextureFormat, +  presentModeCount :: Int, +  presentModes :: ConstPtr WGPUPresentMode, +  alphaModeCount :: Int, +  alphaModes :: ConstPtr WGPUCompositeAlphaMode+}++instance Storable WGPUSurfaceCapabilities where +  alignment _ = #{alignment WGPUSurfaceCapabilities}+  sizeOf _ = #{size WGPUSurfaceCapabilities}+  peek ptr = do +    nextInChain <- #{peek WGPUSurfaceCapabilities, nextInChain} ptr+    usages <- #{peek WGPUSurfaceCapabilities, usages} ptr +    formatCount <- #{peek WGPUSurfaceCapabilities, formatCount} ptr+    formats <- #{peek WGPUSurfaceCapabilities, formats} ptr +    presentModeCount <- #{peek WGPUSurfaceCapabilities, presentModeCount} ptr +    alphaModeCount <- #{peek WGPUSurfaceCapabilities, alphaModeCount} ptr +    alphaModes <- #{peek WGPUSurfaceCapabilities, alphaModes} ptr +    return WGPUSurfaceCapabilities {nextInChain, usages, formatCount, formats, presentModeCount, alphaModeCount, alphaModes}+  poke ptr WGPUSurfaceCapabilities {nextInChain, usages, formatCount, formats, presentModeCount, alphaModeCount, alphaModes} = do +    #{poke WGPUSurfaceCapabilities, nextInChain} ptr nextInChain +    #{poke WGPUSurfaceCapabilities, usages} ptr usages +    #{poke WGPUSurfaceCapabilities, formatCount} ptr formatCount +    #{poke WGPUSurfaceCapabilities, formats} ptr formats +    #{poke WGPUSurfaceCapabilities, presentModeCount} ptr presentModeCount+    #{poke WGPUSurfaceCapabilities, alphaModeCount} ptr alphaModeCount+    #{poke WGPUSurfaceCapabilities, alphaModes} ptr alphaModes+  +data WGPUMultisampleState = WGPUMultisampleState {+  nextInChain :: Ptr WGPUChainedStruct, +  count :: Word32, +  mask :: Word32, +  alphaToCoverageEnabled :: WGPUBool +}++instance Storable WGPUMultisampleState where +  alignment _ = #{alignment WGPUMultisampleState}+  sizeOf _ = #{size WGPUMultisampleState}+  peek ptr = do +    nextInChain <- #{peek WGPUMultisampleState, nextInChain} ptr +    count <- #{peek WGPUMultisampleState, count} ptr +    mask <- #{peek WGPUMultisampleState, mask} ptr +    alphaToCoverageEnabled <- #{peek WGPUMultisampleState, alphaToCoverageEnabled} ptr +    return WGPUMultisampleState {nextInChain, count, mask, alphaToCoverageEnabled}+  poke ptr WGPUMultisampleState {nextInChain, count, mask, alphaToCoverageEnabled} = do +    #{poke WGPUMultisampleState, nextInChain} ptr nextInChain+    #{poke WGPUMultisampleState, count} ptr count+    #{poke WGPUMultisampleState, mask} ptr mask+    #{poke WGPUMultisampleState, alphaToCoverageEnabled} ptr alphaToCoverageEnabled+    +data WGPUPrimitiveState = WGPUPrimitiveState {+  nextInChain :: Ptr WGPUChainedStruct, +  topology :: WGPUPrimitiveTopology, +  stripIndexFormat :: WGPUIndexFormat, +  frontFace :: WGPUFrontFace, +  cullMode :: WGPUCullMode, +  unclippedDepth :: WGPUBool +}++instance Storable WGPUPrimitiveState where+  alignment _ = #{alignment WGPUPrimitiveState}+  sizeOf _ = #{size WGPUPrimitiveState}+  peek ptr = do+    nextInChain <- #{peek WGPUPrimitiveState, nextInChain} ptr+    topology <- #{peek WGPUPrimitiveState, topology} ptr+    stripIndexFormat <- #{peek WGPUPrimitiveState, stripIndexFormat} ptr+    frontFace <- #{peek WGPUPrimitiveState, frontFace} ptr+    cullMode <- #{peek WGPUPrimitiveState, cullMode} ptr+    unclippedDepth <- #{peek WGPUPrimitiveState, unclippedDepth} ptr+    return WGPUPrimitiveState{nextInChain, topology, stripIndexFormat, frontFace, cullMode, unclippedDepth}+  poke ptr WGPUPrimitiveState{nextInChain, topology, stripIndexFormat, frontFace, cullMode, unclippedDepth} = do+    #{poke WGPUPrimitiveState, nextInChain} ptr nextInChain+    #{poke WGPUPrimitiveState, topology} ptr topology+    #{poke WGPUPrimitiveState, stripIndexFormat} ptr stripIndexFormat+    #{poke WGPUPrimitiveState, frontFace} ptr frontFace+    #{poke WGPUPrimitiveState, cullMode} ptr cullMode+    #{poke WGPUPrimitiveState, unclippedDepth} ptr unclippedDepth++data WGPUConstantEntry = WGPUConstantEntry {+  nextInChain :: Ptr WGPUChainedStruct, +  key :: WGPUStringView, +  value :: CDouble+}++instance Storable WGPUConstantEntry where +  alignment _ = #{alignment WGPUConstantEntry}+  sizeOf _ = #{size WGPUConstantEntry}+  peek ptr = do +    nextInChain <- #{peek WGPUConstantEntry, nextInChain} ptr +    key <- #{peek WGPUConstantEntry, key} ptr +    value <- #{peek WGPUConstantEntry, value} ptr +    return WGPUConstantEntry {nextInChain, key, value}+  poke ptr WGPUConstantEntry {nextInChain, key, value} = do +    #{poke WGPUConstantEntry, nextInChain} ptr nextInChain +    #{poke WGPUConstantEntry, key} ptr key +    #{poke WGPUConstantEntry, value} ptr value++data WGPUVertexAttribute = WGPUVertexAttribute {+  nextInChain :: Ptr WGPUChainedStruct,+  format :: WGPUVertexFormat, +  offset :: Word64, +  shaderLocation :: Word32+}++instance Storable WGPUVertexAttribute where+  alignment _ = #{alignment WGPUVertexAttribute}+  sizeOf _ = #{size WGPUVertexAttribute}+  peek ptr = do+    nextInChain <- #{peek WGPUVertexAttribute, nextInChain} ptr+    format <- #{peek WGPUVertexAttribute, format} ptr+    offset <- #{peek WGPUVertexAttribute, offset} ptr+    shaderLocation <- #{peek WGPUVertexAttribute, shaderLocation} ptr+    return WGPUVertexAttribute{nextInChain, format, offset, shaderLocation}+  poke ptr WGPUVertexAttribute{nextInChain, format, offset, shaderLocation} = do+    #{poke WGPUVertexAttribute, nextInChain} ptr nextInChain+    #{poke WGPUVertexAttribute, format} ptr format+    #{poke WGPUVertexAttribute, offset} ptr offset+    #{poke WGPUVertexAttribute, shaderLocation} ptr shaderLocation+++data WGPUVertexBufferLayout = WGPUVertexBufferLayout {+  nextInChain :: Ptr WGPUChainedStruct, +  stepMode :: WGPUVertexStepMode, +  arrayStride :: Word64, +  attributeCount :: Int,+  attributes :: ConstPtr WGPUVertexAttribute+}++instance Storable WGPUVertexBufferLayout where+  alignment _ = #{alignment WGPUVertexBufferLayout}+  sizeOf _ = #{size WGPUVertexBufferLayout}+  peek ptr = do+    nextInChain <- #{peek WGPUVertexBufferLayout, nextInChain} ptr+    stepMode <- #{peek WGPUVertexBufferLayout, stepMode} ptr+    arrayStride <- #{peek WGPUVertexBufferLayout, arrayStride} ptr+    attributeCount <- #{peek WGPUVertexBufferLayout, attributeCount} ptr+    attributes <- #{peek WGPUVertexBufferLayout, attributes} ptr+    return WGPUVertexBufferLayout{nextInChain, stepMode, arrayStride, attributeCount, attributes}+  poke ptr WGPUVertexBufferLayout{nextInChain, stepMode, arrayStride, attributeCount, attributes} = do+    #{poke WGPUVertexBufferLayout, nextInChain} ptr nextInChain+    #{poke WGPUVertexBufferLayout, stepMode} ptr stepMode+    #{poke WGPUVertexBufferLayout, arrayStride} ptr arrayStride+    #{poke WGPUVertexBufferLayout, attributeCount} ptr attributeCount+    #{poke WGPUVertexBufferLayout, attributes} ptr attributes++data WGPUVertexState = WGPUVertexState {+  nextInChain :: Ptr WGPUChainedStruct, +  _module :: Ptr WGPUShaderModule, +  entryPoint :: WGPUStringView, +  constantCount :: Int, +  constants :: ConstPtr WGPUConstantEntry, +  bufferCount :: Int, +  buffers :: ConstPtr WGPUVertexBufferLayout, +  _WGPUVertexState :: Proxy ()+}++instance Storable WGPUVertexState where+  alignment _ = #{alignment WGPUVertexState}+  sizeOf _ = #{size WGPUVertexState}+  peek ptr = do+    nextInChain <- #{peek WGPUVertexState, nextInChain} ptr+    _module <- #{peek WGPUVertexState, module} ptr+    entryPoint <- #{peek WGPUVertexState, entryPoint} ptr+    constantCount <- #{peek WGPUVertexState, constantCount} ptr+    constants <- #{peek WGPUVertexState, constants} ptr+    bufferCount <- #{peek WGPUVertexState, bufferCount} ptr+    buffers <- #{peek WGPUVertexState, buffers} ptr+    return WGPUVertexState{nextInChain, _module, entryPoint, constantCount, constants, bufferCount, buffers, _WGPUVertexState = Proxy}+  poke ptr WGPUVertexState{nextInChain, _module, entryPoint, constantCount, constants, bufferCount, buffers} = do+    #{poke WGPUVertexState, nextInChain} ptr nextInChain+    #{poke WGPUVertexState, module} ptr _module+    #{poke WGPUVertexState, entryPoint} ptr entryPoint+    #{poke WGPUVertexState, constantCount} ptr constantCount+    #{poke WGPUVertexState, constants} ptr constants+    #{poke WGPUVertexState, bufferCount} ptr bufferCount+    #{poke WGPUVertexState, buffers} ptr buffers+++data WGPUBufferBindingLayout = WGPUBufferBindingLayout {+  nextInChain :: Ptr WGPUChainedStruct, +  _type :: WGPUBufferBindingType, +  hasDynamicOffset :: WGPUBool, +  minBindingSize :: Word64+}++instance Storable WGPUBufferBindingLayout where +  alignment _ = #{alignment WGPUBufferBindingLayout}+  sizeOf _ = #{size WGPUBufferBindingLayout}+  peek ptr = do +    nextInChain <- #{peek WGPUBufferBindingLayout, nextInChain} ptr +    _type <- #{peek WGPUBufferBindingLayout, type} ptr+    hasDynamicOffset <- #{peek WGPUBufferBindingLayout, hasDynamicOffset} ptr +    minBindingSize <- #{peek WGPUBufferBindingLayout, minBindingSize} ptr +    return WGPUBufferBindingLayout {nextInChain, _type, hasDynamicOffset, minBindingSize} +  poke ptr WGPUBufferBindingLayout {nextInChain, _type, hasDynamicOffset, minBindingSize} = do +    #{poke WGPUBufferBindingLayout, nextInChain} ptr nextInChain +    #{poke WGPUBufferBindingLayout, type} ptr _type+    #{poke WGPUBufferBindingLayout, hasDynamicOffset} ptr hasDynamicOffset+    #{poke WGPUBufferBindingLayout, minBindingSize} ptr minBindingSize++data WGPUSamplerBindingLayout = WGPUSamplerBindingLayout {+  nextInChain :: Ptr WGPUChainedStruct,+  _type :: WGPUSamplerBindingType+}++instance Storable WGPUSamplerBindingLayout where +  alignment _ = #{alignment WGPUSamplerBindingLayout}+  sizeOf _ = #{size WGPUSamplerBindingLayout}+  peek ptr = do +    nextInChain <- #{peek WGPUSamplerBindingLayout, nextInChain} ptr +    _type <- #{peek WGPUSamplerBindingLayout, type} ptr +    return WGPUSamplerBindingLayout {nextInChain, _type}+  poke ptr WGPUSamplerBindingLayout {nextInChain, _type} = do +    #{poke WGPUSamplerBindingLayout, nextInChain} ptr nextInChain+    #{poke WGPUSamplerBindingLayout, type} ptr _type+  +data WGPUTextureBindingLayout = WGPUTextureBindingLayout {+  nextInChain :: Ptr WGPUChainedStruct, +  sampleType :: WGPUTextureSampleType, +  viewDimension :: WGPUTextureViewDimension, +  multisampled :: WGPUBool+} ++instance Storable WGPUTextureBindingLayout where +  alignment _ = #{alignment WGPUTextureBindingLayout}+  sizeOf _ = #{size WGPUTextureBindingLayout}+  peek ptr = do +    nextInChain <- #{peek WGPUTextureBindingLayout, nextInChain} ptr +    sampleType <- #{peek WGPUTextureBindingLayout, sampleType} ptr+    viewDimension <- #{peek WGPUTextureBindingLayout, viewDimension} ptr+    multisampled <- #{peek WGPUTextureBindingLayout, multisampled} ptr+    return WGPUTextureBindingLayout {nextInChain, sampleType, viewDimension, multisampled}+  poke ptr WGPUTextureBindingLayout {nextInChain, sampleType, viewDimension, multisampled} = do +    #{poke WGPUTextureBindingLayout, nextInChain} ptr nextInChain+    #{poke WGPUTextureBindingLayout, sampleType} ptr sampleType +    #{poke WGPUTextureBindingLayout, viewDimension} ptr viewDimension+    #{poke WGPUTextureBindingLayout, multisampled} ptr multisampled++data WGPUStorageTextureBindingLayout = WGPUStorageTextureBindingLayout {+  nextInChain :: Ptr WGPUChainedStruct, +  access :: WGPUStorageTextureAccess, +  format :: WGPUTextureFormat, +  viewDimension :: WGPUTextureViewDimension+}++instance Storable WGPUStorageTextureBindingLayout where +  alignment _ = #{alignment WGPUStorageTextureBindingLayout}+  sizeOf _ = #{size WGPUStorageTextureBindingLayout}+  peek ptr = do +    nextInChain <- #{peek WGPUStorageTextureBindingLayout, nextInChain} ptr +    access <- #{peek WGPUStorageTextureBindingLayout, access} ptr+    format <- #{peek WGPUStorageTextureBindingLayout, format} ptr+    viewDimension <- #{peek WGPUStorageTextureBindingLayout, viewDimension} ptr+    return WGPUStorageTextureBindingLayout {nextInChain, access, format, viewDimension}+  poke ptr WGPUStorageTextureBindingLayout {nextInChain, access, format, viewDimension} = do +    #{poke WGPUStorageTextureBindingLayout, nextInChain} ptr nextInChain+    #{poke WGPUStorageTextureBindingLayout, access} ptr access +    #{poke WGPUStorageTextureBindingLayout, format} ptr format+    #{poke WGPUStorageTextureBindingLayout, viewDimension} ptr viewDimension++data WGPUBindGroupLayoutEntry = WGPUBindGroupLayoutEntry {+  nextInChain :: Ptr WGPUChainedStruct, +  binding :: Word32, +  visibility :: WGPUShaderStage, +  bindingArraySize :: Word32, +  buffer :: WGPUBufferBindingLayout, +  sampler :: WGPUSamplerBindingLayout, +  texture :: WGPUTextureBindingLayout, +  storageTexture :: WGPUStorageTextureBindingLayout+} ++instance Storable WGPUBindGroupLayoutEntry where +  alignment _ = #{alignment WGPUBindGroupLayoutEntry}+  sizeOf _ = #{size WGPUBindGroupLayoutEntry}+  peek ptr = do +    nextInChain <- #{peek WGPUBindGroupLayoutEntry, nextInChain} ptr +    binding <- #{peek WGPUBindGroupLayoutEntry, binding} ptr+    visibility <- #{peek WGPUBindGroupLayoutEntry, visibility} ptr +    bindingArraySize <- #{peek WGPUBindGroupLayoutEntry, bindingArraySize} ptr+    buffer <- #{peek WGPUBindGroupLayoutEntry, buffer} ptr+    sampler <- #{peek WGPUBindGroupLayoutEntry, sampler} ptr +    texture <- #{peek WGPUBindGroupLayoutEntry, texture} ptr +    storageTexture <- #{peek WGPUBindGroupLayoutEntry, storageTexture} ptr +    return WGPUBindGroupLayoutEntry {nextInChain, binding, visibility, bindingArraySize, buffer, sampler, texture, storageTexture}+  poke ptr WGPUBindGroupLayoutEntry {nextInChain, binding, visibility, bindingArraySize, buffer, sampler, texture, storageTexture} = do+    #{poke WGPUBindGroupLayoutEntry, nextInChain} ptr nextInChain+    #{poke WGPUBindGroupLayoutEntry, binding} ptr binding+    #{poke WGPUBindGroupLayoutEntry, visibility} ptr visibility+    #{poke WGPUBindGroupLayoutEntry, bindingArraySize} ptr bindingArraySize+    #{poke WGPUBindGroupLayoutEntry, buffer} ptr buffer+    #{poke WGPUBindGroupLayoutEntry, sampler} ptr sampler+    #{poke WGPUBindGroupLayoutEntry, texture} ptr texture+    #{poke WGPUBindGroupLayoutEntry, storageTexture} ptr storageTexture+    +data WGPUPipelineLayoutDescriptor = WGPUPipelineLayoutDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  bindGroupLayoutCount :: CSize, +  bindGroupLayouts :: ConstPtr (Ptr WGPUBindGroupLayout),+  immediateSize :: CUInt+}++instance Storable WGPUPipelineLayoutDescriptor where +  alignment _ = #{alignment WGPUPipelineLayoutDescriptor}+  sizeOf _ = #{size WGPUPipelineLayoutDescriptor}+  peek ptr = do +    nextInChain <- #{peek WGPUPipelineLayoutDescriptor, nextInChain} ptr+    label <- #{peek WGPUPipelineLayoutDescriptor, label} ptr+    bindGroupLayoutCount <- #{peek WGPUPipelineLayoutDescriptor, bindGroupLayoutCount} ptr+    bindGroupLayouts <- #{peek WGPUPipelineLayoutDescriptor, bindGroupLayouts} ptr+    immediateSize <- #{peek WGPUPipelineLayoutDescriptor, immediateSize} ptr+    return WGPUPipelineLayoutDescriptor {nextInChain, label, bindGroupLayoutCount, bindGroupLayouts, immediateSize}+  poke ptr WGPUPipelineLayoutDescriptor {nextInChain, label, bindGroupLayoutCount, bindGroupLayouts, immediateSize} = do +    #{poke WGPUPipelineLayoutDescriptor, nextInChain} ptr nextInChain +    #{poke WGPUPipelineLayoutDescriptor, label} ptr label +    #{poke WGPUPipelineLayoutDescriptor, bindGroupLayoutCount} ptr bindGroupLayoutCount +    #{poke WGPUPipelineLayoutDescriptor, bindGroupLayouts} ptr bindGroupLayouts +    #{poke WGPUPipelineLayoutDescriptor, immediateSize} ptr immediateSize ++data WGPUBlendComponent = WGPUBlendComponent {+  operation :: WGPUBlendOperation, +  srcFactor :: WGPUBlendFactor, +  dstFactor :: WGPUBlendFactor+}++instance Storable WGPUBlendComponent where+  alignment _ = #{alignment WGPUBlendComponent}+  sizeOf _ = #{size WGPUBlendComponent}+  peek ptr = do+    operation <- #{peek WGPUBlendComponent, operation} ptr+    srcFactor <- #{peek WGPUBlendComponent, srcFactor} ptr+    dstFactor <- #{peek WGPUBlendComponent, dstFactor} ptr+    return WGPUBlendComponent{operation, srcFactor, dstFactor}+  poke ptr WGPUBlendComponent{operation, srcFactor, dstFactor} = do+    #{poke WGPUBlendComponent, operation} ptr operation+    #{poke WGPUBlendComponent, srcFactor} ptr srcFactor+    #{poke WGPUBlendComponent, dstFactor} ptr dstFactor++data WGPUBlendState = WGPUBlendState {+  color :: WGPUBlendComponent, +  alpha :: WGPUBlendComponent+}++instance Storable WGPUBlendState where+  alignment _ = #{alignment WGPUBlendState}+  sizeOf _ = #{size WGPUBlendState}+  peek ptr = do+    color <- #{peek WGPUBlendState, color} ptr+    alpha <- #{peek WGPUBlendState, alpha} ptr+    return WGPUBlendState{color, alpha}+  poke ptr WGPUBlendState{color, alpha} = do+    #{poke WGPUBlendState, color} ptr color+    #{poke WGPUBlendState, alpha} ptr alpha++data WGPUColorTargetState = WGPUColorTargetState {+  nextInChain :: Ptr WGPUChainedStruct, +  format :: WGPUTextureFormat, +  blend :: ConstPtr WGPUBlendState, +  writeMask :: WGPUColorWriteMask+}++instance Storable WGPUColorTargetState where+  alignment _ = #{alignment WGPUColorTargetState}+  sizeOf _ = #{size WGPUColorTargetState}+  peek ptr = do+    nextInChain <- #{peek WGPUColorTargetState, nextInChain} ptr+    format <- #{peek WGPUColorTargetState, format} ptr+    blend <- #{peek WGPUColorTargetState, blend} ptr+    writeMask <- #{peek WGPUColorTargetState, writeMask} ptr+    return WGPUColorTargetState{nextInChain, format, blend, writeMask}+  poke ptr WGPUColorTargetState{nextInChain, format, blend, writeMask} = do+    #{poke WGPUColorTargetState, nextInChain} ptr nextInChain+    #{poke WGPUColorTargetState, format} ptr format+    #{poke WGPUColorTargetState, blend} ptr blend+    #{poke WGPUColorTargetState, writeMask} ptr writeMask+++data WGPUFragmentState = WGPUFragmentState {+  nextInChain :: Ptr WGPUChainedStruct, +  _module :: Ptr WGPUShaderModule, +  entryPoint :: WGPUStringView, +  constantCount :: Int, +  constants :: ConstPtr WGPUConstantEntry, +  targetCount :: Int, +  targets :: ConstPtr WGPUColorTargetState, +  _WGPUFragmentState :: Proxy ()+}++instance Storable WGPUFragmentState where+  alignment _ = #{alignment WGPUFragmentState}+  sizeOf _ = #{size WGPUFragmentState}+  peek ptr = do+    nextInChain <- #{peek WGPUFragmentState, nextInChain} ptr+    _module <- #{peek WGPUFragmentState, module} ptr+    entryPoint <- #{peek WGPUFragmentState, entryPoint} ptr+    constantCount <- #{peek WGPUFragmentState, constantCount} ptr+    constants <- #{peek WGPUFragmentState, constants} ptr+    targetCount <- #{peek WGPUFragmentState, targetCount} ptr+    targets <- #{peek WGPUFragmentState, targets} ptr+    return WGPUFragmentState{nextInChain, _module, entryPoint, constantCount, constants, targetCount, targets, _WGPUFragmentState = Proxy}+  poke ptr WGPUFragmentState{nextInChain, _module, entryPoint, constantCount, constants, targetCount, targets} = do+    #{poke WGPUFragmentState, nextInChain} ptr nextInChain+    #{poke WGPUFragmentState, module} ptr _module+    #{poke WGPUFragmentState, entryPoint} ptr entryPoint+    #{poke WGPUFragmentState, constantCount} ptr constantCount+    #{poke WGPUFragmentState, constants} ptr constants+    #{poke WGPUFragmentState, targetCount} ptr targetCount+    #{poke WGPUFragmentState, targets} ptr targets++data WGPURenderPipelineDescriptor = WGPURenderPipelineDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  layout :: Ptr WGPUPipelineLayout, +  vertex :: WGPUVertexState, +  primitive :: WGPUPrimitiveState, +  depthStencil :: ConstPtr (), +  multisample :: WGPUMultisampleState, +  fragment :: ConstPtr WGPUFragmentState+}++instance Storable WGPURenderPipelineDescriptor where+  alignment _ = #{alignment WGPURenderPipelineDescriptor}+  sizeOf _ = #{size WGPURenderPipelineDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPURenderPipelineDescriptor, nextInChain} ptr+    label <- #{peek WGPURenderPipelineDescriptor, label} ptr+    layout <- #{peek WGPURenderPipelineDescriptor, layout} ptr+    vertex <- #{peek WGPURenderPipelineDescriptor, vertex} ptr+    primitive <- #{peek WGPURenderPipelineDescriptor, primitive} ptr+    depthStencil <- #{peek WGPURenderPipelineDescriptor, depthStencil} ptr+    multisample <- #{peek WGPURenderPipelineDescriptor, multisample} ptr+    fragment <- #{peek WGPURenderPipelineDescriptor, fragment} ptr+    return WGPURenderPipelineDescriptor{nextInChain, label, layout, vertex, primitive, depthStencil, multisample, fragment}+  poke ptr WGPURenderPipelineDescriptor{nextInChain, label, layout, vertex, primitive, depthStencil, multisample, fragment} = do+    #{poke WGPURenderPipelineDescriptor, nextInChain} ptr nextInChain+    #{poke WGPURenderPipelineDescriptor, label} ptr label+    #{poke WGPURenderPipelineDescriptor, layout} ptr layout+    #{poke WGPURenderPipelineDescriptor, vertex} ptr vertex+    #{poke WGPURenderPipelineDescriptor, primitive} ptr primitive+    #{poke WGPURenderPipelineDescriptor, depthStencil} ptr depthStencil+    #{poke WGPURenderPipelineDescriptor, multisample} ptr multisample+    #{poke WGPURenderPipelineDescriptor, fragment} ptr fragment++data WGPUSurfaceConfiguration = WGPUSurfaceConfiguration {+  nextInChain :: Ptr WGPUChainedStruct, +  device :: Ptr WGPUDevice, +  format :: WGPUTextureFormat, +  usage :: WGPUTextureUsage, +  width :: CInt, +  height :: CInt, +  viewFormatCount :: Int, +  viewFormats :: ConstPtr WGPUTextureFormat, +  alphaMode :: WGPUCompositeAlphaMode, +  presentMode :: WGPUPresentMode+}++instance Storable WGPUSurfaceConfiguration where+  alignment _ = #{alignment WGPUSurfaceConfiguration}+  sizeOf _ = #{size WGPUSurfaceConfiguration}+  peek ptr = do+    nextInChain <- #{peek WGPUSurfaceConfiguration, nextInChain} ptr+    device <- #{peek WGPUSurfaceConfiguration, device} ptr+    format <- #{peek WGPUSurfaceConfiguration, format} ptr+    usage <- #{peek WGPUSurfaceConfiguration, usage} ptr+    width <- #{peek WGPUSurfaceConfiguration, width} ptr+    height <- #{peek WGPUSurfaceConfiguration, height} ptr+    viewFormatCount <- #{peek WGPUSurfaceConfiguration, viewFormatCount} ptr+    viewFormats <- #{peek WGPUSurfaceConfiguration, viewFormats} ptr+    alphaMode <- #{peek WGPUSurfaceConfiguration, alphaMode} ptr+    presentMode <- #{peek WGPUSurfaceConfiguration, presentMode} ptr+    return WGPUSurfaceConfiguration{nextInChain, device, format, usage, width, height, viewFormatCount, viewFormats, alphaMode, presentMode}+  poke ptr WGPUSurfaceConfiguration{nextInChain, device, format, usage, width, height, viewFormatCount, viewFormats, alphaMode, presentMode} = do+    #{poke WGPUSurfaceConfiguration, nextInChain} ptr nextInChain+    #{poke WGPUSurfaceConfiguration, device} ptr device+    #{poke WGPUSurfaceConfiguration, format} ptr format+    #{poke WGPUSurfaceConfiguration, usage} ptr usage+    #{poke WGPUSurfaceConfiguration, width} ptr width+    #{poke WGPUSurfaceConfiguration, height} ptr height+    #{poke WGPUSurfaceConfiguration, viewFormatCount} ptr viewFormatCount+    #{poke WGPUSurfaceConfiguration, viewFormats} ptr viewFormats+    #{poke WGPUSurfaceConfiguration, alphaMode} ptr alphaMode+    #{poke WGPUSurfaceConfiguration, presentMode} ptr presentMode++data WGPUSurfaceTexture = WGPUSurfaceTexture {+  nextInChain :: Ptr WGPUChainedStruct, +  texture :: Ptr WGPUTexture, +  status :: WGPUSurfaceGetCurrentTextureStatus+}++instance Storable WGPUSurfaceTexture where+  alignment _ = #{alignment WGPUSurfaceTexture}+  sizeOf _ = #{size WGPUSurfaceTexture}+  peek ptr = do+    nextInChain <- #{peek WGPUSurfaceTexture, nextInChain} ptr+    texture <- #{peek WGPUSurfaceTexture, texture} ptr+    status <- #{peek WGPUSurfaceTexture, status} ptr+    return WGPUSurfaceTexture{nextInChain, texture, status}+  poke ptr WGPUSurfaceTexture{nextInChain, texture, status} = do+    #{poke WGPUSurfaceTexture, nextInChain} ptr nextInChain+    #{poke WGPUSurfaceTexture, texture} ptr texture+    #{poke WGPUSurfaceTexture, status} ptr status++data WGPUCommandEncoderDescriptor = WGPUCommandEncoderDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView+}++instance Storable WGPUCommandEncoderDescriptor where+  alignment _ = #{alignment WGPUCommandEncoderDescriptor}+  sizeOf _ = #{size WGPUCommandEncoderDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUCommandEncoderDescriptor, nextInChain} ptr+    label <- #{peek WGPUCommandEncoderDescriptor, label} ptr+    return WGPUCommandEncoderDescriptor{nextInChain, label}+  poke ptr WGPUCommandEncoderDescriptor{nextInChain, label} = do+    #{poke WGPUCommandEncoderDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUCommandEncoderDescriptor, label} ptr label++data WGPUColor = WGPUColor {+  wgpuColorR :: CDouble, +  wgpuColorG :: CDouble, +  wgpuColorB :: CDouble, +  wgpuColorA :: CDouble+}++instance Storable WGPUColor where+  alignment _ = #{alignment WGPUColor}+  sizeOf _ = #{size WGPUColor}+  peek ptr = do+    wgpuColorR <- #{peek WGPUColor, r} ptr+    wgpuColorG <- #{peek WGPUColor, g} ptr+    wgpuColorB <- #{peek WGPUColor, b} ptr+    wgpuColorA <- #{peek WGPUColor, a} ptr+    return WGPUColor{wgpuColorR, wgpuColorG, wgpuColorB, wgpuColorA}+  poke ptr WGPUColor{wgpuColorR, wgpuColorG, wgpuColorB, wgpuColorA} = do+    #{poke WGPUColor, r} ptr wgpuColorR+    #{poke WGPUColor, g} ptr wgpuColorG+    #{poke WGPUColor, b} ptr wgpuColorB+    #{poke WGPUColor, a} ptr wgpuColorA++data WGPURenderPassColorAttachment = WGPURenderPassColorAttachment {+  nextInChain :: Ptr WGPUChainedStruct, +  view :: Ptr WGPUTextureView, +  depthSlice :: Word32, +  resolveTarget :: Ptr WGPUTextureView, +  loadOp :: WGPULoadOp,+  storeOp :: WGPUStoreOp,+  clearValue :: WGPUColor    +}++instance Storable WGPURenderPassColorAttachment where+  alignment _ = #{alignment WGPURenderPassColorAttachment}+  sizeOf _ = #{size WGPURenderPassColorAttachment}+  peek ptr = do+    nextInChain <- #{peek WGPURenderPassColorAttachment, nextInChain} ptr+    view <- #{peek WGPURenderPassColorAttachment, view} ptr+    depthSlice <- #{peek WGPURenderPassColorAttachment, depthSlice} ptr+    resolveTarget <- #{peek WGPURenderPassColorAttachment, resolveTarget} ptr+    loadOp <- #{peek WGPURenderPassColorAttachment, loadOp} ptr+    storeOp <- #{peek WGPURenderPassColorAttachment, storeOp} ptr+    clearValue <- #{peek WGPURenderPassColorAttachment, clearValue} ptr+    return WGPURenderPassColorAttachment{nextInChain, view, depthSlice, resolveTarget, loadOp, storeOp, clearValue}+  poke ptr WGPURenderPassColorAttachment{nextInChain, view, depthSlice, resolveTarget, loadOp, storeOp, clearValue} = do+    #{poke WGPURenderPassColorAttachment, nextInChain} ptr nextInChain+    #{poke WGPURenderPassColorAttachment, view} ptr view+    #{poke WGPURenderPassColorAttachment, depthSlice} ptr depthSlice+    #{poke WGPURenderPassColorAttachment, resolveTarget} ptr resolveTarget+    #{poke WGPURenderPassColorAttachment, loadOp} ptr loadOp+    #{poke WGPURenderPassColorAttachment, storeOp} ptr storeOp+    #{poke WGPURenderPassColorAttachment, clearValue} ptr clearValue++data WGPURenderPassDescriptor = WGPURenderPassDescriptor {+  nextInChain :: Ptr WGPUChainedStruct,+  label :: WGPUStringView, +  colorAttachmentCount :: Int, +  colorAttachments :: ConstPtr WGPURenderPassColorAttachment, +  depthStencilAttachment :: ConstPtr (), +  occlusionQuerySet :: Ptr WGPUQuerySet, +  timestampWrites :: ConstPtr () +}++instance Storable WGPURenderPassDescriptor where+  alignment _ = #{alignment WGPURenderPassDescriptor}+  sizeOf _ = #{size WGPURenderPassDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPURenderPassDescriptor, nextInChain} ptr+    label <- #{peek WGPURenderPassDescriptor, label} ptr+    colorAttachmentCount <- #{peek WGPURenderPassDescriptor, colorAttachmentCount} ptr+    colorAttachments <- #{peek WGPURenderPassDescriptor, colorAttachments} ptr+    depthStencilAttachment <- #{peek WGPURenderPassDescriptor, depthStencilAttachment} ptr+    occlusionQuerySet <- #{peek WGPURenderPassDescriptor, occlusionQuerySet} ptr+    timestampWrites <- #{peek WGPURenderPassDescriptor, timestampWrites} ptr+    return WGPURenderPassDescriptor{nextInChain, label, colorAttachmentCount, colorAttachments, depthStencilAttachment, occlusionQuerySet, timestampWrites}+  poke ptr WGPURenderPassDescriptor{nextInChain, label, colorAttachmentCount, colorAttachments, depthStencilAttachment, occlusionQuerySet, timestampWrites} = do+    #{poke WGPURenderPassDescriptor, nextInChain} ptr nextInChain+    #{poke WGPURenderPassDescriptor, label} ptr label+    #{poke WGPURenderPassDescriptor, colorAttachmentCount} ptr colorAttachmentCount+    #{poke WGPURenderPassDescriptor, colorAttachments} ptr colorAttachments+    #{poke WGPURenderPassDescriptor, depthStencilAttachment} ptr depthStencilAttachment+    #{poke WGPURenderPassDescriptor, occlusionQuerySet} ptr occlusionQuerySet+    #{poke WGPURenderPassDescriptor, timestampWrites} ptr timestampWrites++wGPU_DEPTH_SLICE_UNDEFINED :: Word32 +wGPU_DEPTH_SLICE_UNDEFINED = #const WGPU_DEPTH_SLICE_UNDEFINED++data WGPUCommandBufferDescriptor = WGPUCommandBufferDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView+}++instance Storable WGPUCommandBufferDescriptor where+  alignment _ = #{alignment WGPUCommandBufferDescriptor}+  sizeOf _ = #{size WGPUCommandBufferDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUCommandBufferDescriptor, nextInChain} ptr+    label <- #{peek WGPUCommandBufferDescriptor, label} ptr+    return WGPUCommandBufferDescriptor{nextInChain, label}+  poke ptr WGPUCommandBufferDescriptor{nextInChain, label} = do+    #{poke WGPUCommandBufferDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUCommandBufferDescriptor, label} ptr label++data WGPUExtent3D = WGPUExtent3D {+  width :: Word32, +  height :: Word32, +  depthOrArrayLayers :: Word32 +}++instance Storable WGPUExtent3D where+  alignment _ = #{alignment WGPUExtent3D}+  sizeOf _ = #{size WGPUExtent3D}+  peek ptr = do+    width <- #{peek WGPUExtent3D, width} ptr+    height <- #{peek WGPUExtent3D, height} ptr+    depthOrArrayLayers <- #{peek WGPUExtent3D, depthOrArrayLayers} ptr+    return WGPUExtent3D{width, height, depthOrArrayLayers}+  poke ptr WGPUExtent3D{width, height, depthOrArrayLayers} = do+    #{poke WGPUExtent3D, width} ptr width+    #{poke WGPUExtent3D, height} ptr height+    #{poke WGPUExtent3D, depthOrArrayLayers} ptr depthOrArrayLayers++data WGPUTextureDescriptor = WGPUTextureDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  usage :: WGPUTextureUsage, +  dimension :: WGPUTextureDimension, +  size :: WGPUExtent3D, +  format :: WGPUTextureFormat, +  mipLevelCount :: Word32, +  sampleCount :: Word32, +  viewFormatCount :: CSize, +  viewFormats :: ConstPtr WGPUTextureFormat+}++instance Storable WGPUTextureDescriptor where+  alignment _ = #{alignment WGPUTextureDescriptor}+  sizeOf _ = #{size WGPUTextureDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUTextureDescriptor, nextInChain} ptr+    label <- #{peek WGPUTextureDescriptor, label} ptr+    usage <- #{peek WGPUTextureDescriptor, usage} ptr+    dimension <- #{peek WGPUTextureDescriptor, dimension} ptr+    size <- #{peek WGPUTextureDescriptor, size} ptr+    format <- #{peek WGPUTextureDescriptor, format} ptr+    mipLevelCount <- #{peek WGPUTextureDescriptor, mipLevelCount} ptr+    sampleCount <- #{peek WGPUTextureDescriptor, sampleCount} ptr+    viewFormatCount <- #{peek WGPUTextureDescriptor, viewFormatCount} ptr+    viewFormats <- #{peek WGPUTextureDescriptor, viewFormats} ptr+    return WGPUTextureDescriptor{nextInChain, label, usage, dimension, size, format, mipLevelCount, sampleCount, viewFormatCount, viewFormats}+  poke ptr WGPUTextureDescriptor{nextInChain, label, usage, dimension, size, format, mipLevelCount, sampleCount, viewFormatCount, viewFormats} = do+    #{poke WGPUTextureDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUTextureDescriptor, label} ptr label+    #{poke WGPUTextureDescriptor, usage} ptr usage+    #{poke WGPUTextureDescriptor, dimension} ptr dimension+    #{poke WGPUTextureDescriptor, size} ptr size+    #{poke WGPUTextureDescriptor, format} ptr format+    #{poke WGPUTextureDescriptor, mipLevelCount} ptr mipLevelCount+    #{poke WGPUTextureDescriptor, sampleCount} ptr sampleCount+    #{poke WGPUTextureDescriptor, viewFormatCount} ptr viewFormatCount+    #{poke WGPUTextureDescriptor, viewFormats} ptr viewFormats++data WGPUOrigin3D = WGPUOrigin3D {+  x :: Word32, +  y :: Word32, +  z :: Word32+}++instance Storable WGPUOrigin3D where+  alignment _ = #{alignment WGPUOrigin3D}+  sizeOf _ = #{size WGPUOrigin3D}+  peek ptr = do+    x <- #{peek WGPUOrigin3D, x} ptr+    y <- #{peek WGPUOrigin3D, y} ptr+    z <- #{peek WGPUOrigin3D, z} ptr+    return WGPUOrigin3D{x, y, z}+  poke ptr WGPUOrigin3D{x, y, z} = do+    #{poke WGPUOrigin3D, x} ptr x+    #{poke WGPUOrigin3D, y} ptr y+    #{poke WGPUOrigin3D, z} ptr z++data WGPUTexelCopyTextureInfo = WGPUTexelCopyTextureInfo {+  texture :: Ptr WGPUTexture, +  mipLevel :: Word32, +  origin :: WGPUOrigin3D, +  aspect :: WGPUTextureAspect+}++instance Storable WGPUTexelCopyTextureInfo where+  alignment _ = #{alignment WGPUTexelCopyTextureInfo}+  sizeOf _ = #{size WGPUTexelCopyTextureInfo}+  peek ptr = do+    texture <- #{peek WGPUTexelCopyTextureInfo, texture} ptr+    mipLevel <- #{peek WGPUTexelCopyTextureInfo, mipLevel} ptr+    origin <- #{peek WGPUTexelCopyTextureInfo, origin} ptr+    aspect <- #{peek WGPUTexelCopyTextureInfo, aspect} ptr+    return WGPUTexelCopyTextureInfo{texture, mipLevel, origin, aspect}+  poke ptr WGPUTexelCopyTextureInfo{texture, mipLevel, origin, aspect} = do+    #{poke WGPUTexelCopyTextureInfo, texture} ptr texture+    #{poke WGPUTexelCopyTextureInfo, mipLevel} ptr mipLevel+    #{poke WGPUTexelCopyTextureInfo, origin} ptr origin+    #{poke WGPUTexelCopyTextureInfo, aspect} ptr aspect++data WGPUTexelCopyBufferLayout = WGPUTexelCopyBufferLayout {+  offset :: Word64, +  bytesPerRow :: Word32, +  rowsPerImage :: Word32+}++instance Storable WGPUTexelCopyBufferLayout where+  alignment _ = #{alignment WGPUTexelCopyBufferLayout}+  sizeOf _ = #{size WGPUTexelCopyBufferLayout}+  peek ptr = do+    offset <- #{peek WGPUTexelCopyBufferLayout, offset} ptr+    bytesPerRow <- #{peek WGPUTexelCopyBufferLayout, bytesPerRow} ptr+    rowsPerImage <- #{peek WGPUTexelCopyBufferLayout, rowsPerImage} ptr+    return WGPUTexelCopyBufferLayout{offset, bytesPerRow, rowsPerImage}+  poke ptr WGPUTexelCopyBufferLayout{offset, bytesPerRow, rowsPerImage} = do+    #{poke WGPUTexelCopyBufferLayout, offset} ptr offset+    #{poke WGPUTexelCopyBufferLayout, bytesPerRow} ptr bytesPerRow+    #{poke WGPUTexelCopyBufferLayout, rowsPerImage} ptr rowsPerImage+++data WGPUSamplerDescriptor = WGPUSamplerDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  addressModeU :: WGPUAddressMode, +  addressModeV :: WGPUAddressMode, +  addressModeW :: WGPUAddressMode, +  magFilter :: WGPUFilterMode, +  minFilter :: WGPUFilterMode, +  mipmapFilter :: WGPUMipmapFilterMode, +  lodMinClamp :: Float, +  lodMaxClamp :: Float, +  compare :: WGPUCompareFunction, +  maxAnisotropy :: Word16+}++instance Storable WGPUSamplerDescriptor where+  alignment _ = #{alignment WGPUSamplerDescriptor}+  sizeOf _ = #{size WGPUSamplerDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUSamplerDescriptor, nextInChain} ptr+    label <- #{peek WGPUSamplerDescriptor, label} ptr+    addressModeU <- #{peek WGPUSamplerDescriptor, addressModeU} ptr+    addressModeV <- #{peek WGPUSamplerDescriptor, addressModeV} ptr+    addressModeW <- #{peek WGPUSamplerDescriptor, addressModeW} ptr+    magFilter <- #{peek WGPUSamplerDescriptor, magFilter} ptr+    minFilter <- #{peek WGPUSamplerDescriptor, minFilter} ptr+    mipmapFilter <- #{peek WGPUSamplerDescriptor, mipmapFilter} ptr+    lodMinClamp <- #{peek WGPUSamplerDescriptor, lodMinClamp} ptr+    lodMaxClamp <- #{peek WGPUSamplerDescriptor, lodMaxClamp} ptr+    compare <- #{peek WGPUSamplerDescriptor, compare} ptr+    maxAnisotropy <- #{peek WGPUSamplerDescriptor, maxAnisotropy} ptr+    return WGPUSamplerDescriptor{nextInChain, label, addressModeU, addressModeV, addressModeW, magFilter, minFilter, mipmapFilter, lodMinClamp, lodMaxClamp, compare, maxAnisotropy}+  poke ptr WGPUSamplerDescriptor{nextInChain, label, addressModeU, addressModeV, addressModeW, magFilter, minFilter, mipmapFilter, lodMinClamp, lodMaxClamp, compare, maxAnisotropy} = do+    #{poke WGPUSamplerDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUSamplerDescriptor, label} ptr label+    #{poke WGPUSamplerDescriptor, addressModeU} ptr addressModeU+    #{poke WGPUSamplerDescriptor, addressModeV} ptr addressModeV+    #{poke WGPUSamplerDescriptor, addressModeW} ptr addressModeW+    #{poke WGPUSamplerDescriptor, magFilter} ptr magFilter+    #{poke WGPUSamplerDescriptor, minFilter} ptr minFilter+    #{poke WGPUSamplerDescriptor, mipmapFilter} ptr mipmapFilter+    #{poke WGPUSamplerDescriptor, lodMinClamp} ptr lodMinClamp+    #{poke WGPUSamplerDescriptor, lodMaxClamp} ptr lodMaxClamp+    #{poke WGPUSamplerDescriptor, compare} ptr compare+    #{poke WGPUSamplerDescriptor, maxAnisotropy} ptr maxAnisotropy++data WGPUBindGroupLayoutDescriptor = WGPUBindGroupLayoutDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  entryCount :: CSize, +  entries :: ConstPtr WGPUBindGroupLayoutEntry+}++instance Storable WGPUBindGroupLayoutDescriptor where+  alignment _ = #{alignment WGPUBindGroupLayoutDescriptor}+  sizeOf _ = #{size WGPUBindGroupLayoutDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUBindGroupLayoutDescriptor, nextInChain} ptr+    label <- #{peek WGPUBindGroupLayoutDescriptor, label} ptr+    entryCount <- #{peek WGPUBindGroupLayoutDescriptor, entryCount} ptr+    entries <- #{peek WGPUBindGroupLayoutDescriptor, entries} ptr+    return WGPUBindGroupLayoutDescriptor{nextInChain, label, entryCount, entries}+  poke ptr WGPUBindGroupLayoutDescriptor{nextInChain, label, entryCount, entries} = do+    #{poke WGPUBindGroupLayoutDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUBindGroupLayoutDescriptor, label} ptr label+    #{poke WGPUBindGroupLayoutDescriptor, entryCount} ptr entryCount+    #{poke WGPUBindGroupLayoutDescriptor, entries} ptr entries++data WGPUBindGroupEntry = WGPUBindGroupEntry {+  nextInChain :: Ptr WGPUChainedStruct, +  binding :: Word32, +  buffer :: Ptr WGPUBuffer, +  offset :: Word64, +  size :: Word64, +  sampler :: Ptr WGPUSampler, +  textureView :: Ptr WGPUTextureView+}++instance Storable WGPUBindGroupEntry where+  alignment _ = #{alignment WGPUBindGroupEntry}+  sizeOf _ = #{size WGPUBindGroupEntry}+  peek ptr = do+    nextInChain <- #{peek WGPUBindGroupEntry, nextInChain} ptr+    binding <- #{peek WGPUBindGroupEntry, binding} ptr+    buffer <- #{peek WGPUBindGroupEntry, buffer} ptr+    offset <- #{peek WGPUBindGroupEntry, offset} ptr+    size <- #{peek WGPUBindGroupEntry, size} ptr+    sampler <- #{peek WGPUBindGroupEntry, sampler} ptr+    textureView <- #{peek WGPUBindGroupEntry, textureView} ptr+    return WGPUBindGroupEntry{nextInChain, binding, buffer, offset, size, sampler, textureView}+  poke ptr WGPUBindGroupEntry{nextInChain, binding, buffer, offset, size, sampler, textureView} = do+    #{poke WGPUBindGroupEntry, nextInChain} ptr nextInChain+    #{poke WGPUBindGroupEntry, binding} ptr binding+    #{poke WGPUBindGroupEntry, buffer} ptr buffer+    #{poke WGPUBindGroupEntry, offset} ptr offset+    #{poke WGPUBindGroupEntry, size} ptr size+    #{poke WGPUBindGroupEntry, sampler} ptr sampler+    #{poke WGPUBindGroupEntry, textureView} ptr textureView++data WGPUBindGroupDescriptor = WGPUBindGroupDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  layout :: Ptr WGPUBindGroupLayout, +  entryCount :: CSize, +  entries :: ConstPtr WGPUBindGroupEntry+}+ +instance Storable WGPUBindGroupDescriptor where+  alignment _ = #{alignment WGPUBindGroupDescriptor}+  sizeOf _ = #{size WGPUBindGroupDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUBindGroupDescriptor, nextInChain} ptr+    label <- #{peek WGPUBindGroupDescriptor, label} ptr+    layout <- #{peek WGPUBindGroupDescriptor, layout} ptr+    entryCount <- #{peek WGPUBindGroupDescriptor, entryCount} ptr+    entries <- #{peek WGPUBindGroupDescriptor, entries} ptr+    return WGPUBindGroupDescriptor{nextInChain, label, layout, entryCount, entries}+  poke ptr WGPUBindGroupDescriptor{nextInChain, label, layout, entryCount, entries} = do+    #{poke WGPUBindGroupDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUBindGroupDescriptor, label} ptr label+    #{poke WGPUBindGroupDescriptor, layout} ptr layout+    #{poke WGPUBindGroupDescriptor, entryCount} ptr entryCount+    #{poke WGPUBindGroupDescriptor, entries} ptr entries+++data WGPUTextureViewDescriptor = WGPUTextureViewDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  format :: WGPUTextureFormat, +  dimension :: WGPUTextureViewDimension, +  baseMipLevel :: Word32, +  mipLevelCount :: Word32, +  baseArrayLayer :: Word32, +  arrayLayerCount :: Word32, +  aspect :: WGPUTextureAspect, +  usage :: WGPUTextureUsage+}++instance Storable WGPUTextureViewDescriptor where+  alignment _ = #{alignment WGPUTextureViewDescriptor}+  sizeOf _ = #{size WGPUTextureViewDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUTextureViewDescriptor, nextInChain} ptr+    label <- #{peek WGPUTextureViewDescriptor, label} ptr+    format <- #{peek WGPUTextureViewDescriptor, format} ptr+    dimension <- #{peek WGPUTextureViewDescriptor, dimension} ptr+    baseMipLevel <- #{peek WGPUTextureViewDescriptor, baseMipLevel} ptr+    mipLevelCount <- #{peek WGPUTextureViewDescriptor, mipLevelCount} ptr+    baseArrayLayer <- #{peek WGPUTextureViewDescriptor, baseArrayLayer} ptr+    arrayLayerCount <- #{peek WGPUTextureViewDescriptor, arrayLayerCount} ptr+    aspect <- #{peek WGPUTextureViewDescriptor, aspect} ptr+    usage <- #{peek WGPUTextureViewDescriptor, usage} ptr+    return WGPUTextureViewDescriptor{nextInChain, label, format, dimension, baseMipLevel, mipLevelCount, baseArrayLayer, arrayLayerCount, aspect, usage}+  poke ptr WGPUTextureViewDescriptor{nextInChain, label, format, dimension, baseMipLevel, mipLevelCount, baseArrayLayer, arrayLayerCount, aspect, usage} = do+    #{poke WGPUTextureViewDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUTextureViewDescriptor, label} ptr label+    #{poke WGPUTextureViewDescriptor, format} ptr format+    #{poke WGPUTextureViewDescriptor, dimension} ptr dimension+    #{poke WGPUTextureViewDescriptor, baseMipLevel} ptr baseMipLevel+    #{poke WGPUTextureViewDescriptor, mipLevelCount} ptr mipLevelCount+    #{poke WGPUTextureViewDescriptor, baseArrayLayer} ptr baseArrayLayer+    #{poke WGPUTextureViewDescriptor, arrayLayerCount} ptr arrayLayerCount+    #{poke WGPUTextureViewDescriptor, aspect} ptr aspect+    #{poke WGPUTextureViewDescriptor, usage} ptr usage+++data WGPUBufferDescriptor = WGPUBufferDescriptor {+  nextInChain :: Ptr WGPUChainedStruct, +  label :: WGPUStringView, +  usage :: WGPUBufferUsage, +  size :: Word64, +  mappedAtCreation :: WGPUBool+}++instance Storable WGPUBufferDescriptor where+  alignment _ = #{alignment WGPUBufferDescriptor}+  sizeOf _ = #{size WGPUBufferDescriptor}+  peek ptr = do+    nextInChain <- #{peek WGPUBufferDescriptor, nextInChain} ptr+    label <- #{peek WGPUBufferDescriptor, label} ptr+    usage <- #{peek WGPUBufferDescriptor, usage} ptr+    size <- #{peek WGPUBufferDescriptor, size} ptr+    mappedAtCreation <- #{peek WGPUBufferDescriptor, mappedAtCreation} ptr+    return WGPUBufferDescriptor{nextInChain, label, usage, size, mappedAtCreation}+  poke ptr WGPUBufferDescriptor{nextInChain, label, usage, size, mappedAtCreation} = do+    #{poke WGPUBufferDescriptor, nextInChain} ptr nextInChain+    #{poke WGPUBufferDescriptor, label} ptr label+    #{poke WGPUBufferDescriptor, usage} ptr usage+    #{poke WGPUBufferDescriptor, size} ptr size+    #{poke WGPUBufferDescriptor, mappedAtCreation} ptr mappedAtCreation
+ test/Main.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad (void)+import Data.Default+import Data.Text (Text)+import Mischief.Animation+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Time qualified as Time+import Mischief.Input+import Mischief.Input.Keys qualified as Keys+import Mischief.Materials.Sprite+import Mischief.Math hiding (qd)+import Mischief.Math.Transform qualified as Transform+import Mischief.Render++main :: IO ()+main = do+  app <- newApp+  setAssetSource "../assets" app+  addPlugin @MainPlugin app+  runApp app++data MainPlugin++instance Plugin MainPlugin where+  init = do+    window <- spawn (Window, WindowTitle "Test")+    void $ spawn (Camera, Rel OutputTo window)+  deps = [dep @RenderPlugin]