-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Basic rendering programs for Keid engine. -- -- Basic rendering programs for Keid engine. @package keid-render-basic @version 0.1.8.0 module Global.Resource.CubeMap.Base.Paths pattern BLACK_KTX_ZST :: FilePath pattern BLACK_KTX2 :: FilePath module Global.Resource.CubeMap.Base data Collection a Collection :: a -> Collection a [$sel:black:Collection] :: Collection a -> a type Textures = Collection (Texture CubeMap) sources :: Collection Source instance GHC.Base.Applicative Global.Resource.CubeMap.Base.Collection instance GHC.Generics.Generic1 Global.Resource.CubeMap.Base.Collection instance Data.Traversable.Traversable Global.Resource.CubeMap.Base.Collection instance Data.Foldable.Foldable Global.Resource.CubeMap.Base.Collection instance GHC.Base.Functor Global.Resource.CubeMap.Base.Collection instance GHC.Show.Show a => GHC.Show.Show (Global.Resource.CubeMap.Base.Collection a) module Global.Resource.Texture.Base.Paths pattern BLACK_KTX_ZST :: FilePath pattern IBL_BRDF_LUT_KTX_ZST :: FilePath pattern BLACK_KTX2 :: FilePath pattern IBL_BRDF_LUT_KTX2 :: FilePath pattern FLAT_KTX_ZST :: FilePath pattern FLAT_KTX2 :: FilePath module Global.Resource.Texture.Base data Collection a Collection :: a -> a -> a -> Collection a [$sel:black:Collection] :: Collection a -> a [$sel:flat:Collection] :: Collection a -> a [$sel:ibl_brdf_lut:Collection] :: Collection a -> a type Textures = Collection (Texture Flat) sources :: Collection Source instance GHC.Base.Applicative Global.Resource.Texture.Base.Collection instance GHC.Generics.Generic1 Global.Resource.Texture.Base.Collection instance Data.Traversable.Traversable Global.Resource.Texture.Base.Collection instance Data.Foldable.Foldable Global.Resource.Texture.Base.Collection instance GHC.Base.Functor Global.Resource.Texture.Base.Collection instance GHC.Show.Show a => GHC.Show.Show (Global.Resource.Texture.Base.Collection a) module Render.Code.Lit raySphereIntersection :: Code -- | The Henyey-Greenstein Phase Function hgPhase :: Code structLight :: Code structMaterial :: Code shadowFuns :: Code litMain :: Code brdfSpecular :: Code module Render.DescSets.Set0.Code set0binding0 :: Code set0binding1 :: Code set0binding2 :: Code set0binding3 :: Code set0binding4 :: Code set0binding5 :: Code set0binding5color :: Code set0binding6 :: Code module Render.DepthOnly.Code vert :: Code module Render.Debug.Code vert :: Code frag :: Code module Render.DescSets.Sun data Sun Sun :: Transform -> Vec4 -> Vec4 -> Vec4 -> Vec4 -> Sun [$sel:sunViewProjection:Sun] :: Sun -> Transform [$sel:sunShadow:Sun] :: Sun -> Vec4 [$sel:sunPosition:Sun] :: Sun -> Vec4 [$sel:sunDirection:Sun] :: Sun -> Vec4 [$sel:sunColor:Sun] :: Sun -> Vec4 createSet0Ds :: Tagged '[Sun] DescriptorSetLayout -> ResourceT (StageRIO st) (Tagged '[Sun] (Vector DescriptorSet), Buffer) set0 :: Tagged Sun DsLayoutBindings -- | Maximum "guaranteed" amount for multiview passes pattern MAX_VIEWS :: Int type Buffer = Allocated 'Coherent Sun data SunInput SunInput :: Vec4 -> Float -> Float -> Float -> Vec3 -> Float -> Float -> Float -> SunInput [$sel:siColor:SunInput] :: SunInput -> Vec4 [$sel:siInclination:SunInput] :: SunInput -> Float [$sel:siAzimuth:SunInput] :: SunInput -> Float [$sel:siRadius:SunInput] :: SunInput -> Float [$sel:siTarget:SunInput] :: SunInput -> Vec3 [$sel:siDepthRange:SunInput] :: SunInput -> Float [$sel:siSize:SunInput] :: SunInput -> Float [$sel:siShadowIx:SunInput] :: SunInput -> Float initialSunInput :: SunInput type Process = Cell SunInput ("bounding box" ::: Transform, Sun) spawn1 :: (MonadResource m, MonadUnliftIO m) => SunInput -> m Process mkSun :: SunInput -> ("bounding box" ::: Transform, Sun) type Observer = ObserverIO (Vector ("bounding box" ::: Transform)) newObserver1 :: MonadIO m => m Observer observe1 :: MonadUnliftIO m => Process -> Observer -> Buffer -> m () instance GHC.Generics.Generic Render.DescSets.Sun.Sun instance GHC.Show.Show Render.DescSets.Sun.Sun instance Foreign.Storable.Generic.Internal.GStorable Render.DescSets.Sun.Sun instance Vulkan.Zero.Zero Render.DescSets.Sun.Sun module Render.Font.EvanwSdf.Code vert :: Code frag :: Code module Render.Font.EvanwSdf.Model data InstanceAttrs InstanceAttrs :: Vec4 -> Vec4 -> Vec4 -> Vec4 -> Int32 -> Int32 -> Float -> Float -> InstanceAttrs [$sel:vertRect:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:fragRect:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:color:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:outlineColor:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:samplerId:InstanceAttrs] :: InstanceAttrs -> Int32 [$sel:textureId:InstanceAttrs] :: InstanceAttrs -> Int32 [$sel:smoothing:InstanceAttrs] :: InstanceAttrs -> Float [$sel:outlineWidth:InstanceAttrs] :: InstanceAttrs -> Float instance GHC.Generics.Generic Render.Font.EvanwSdf.Model.InstanceAttrs instance GHC.Show.Show Render.Font.EvanwSdf.Model.InstanceAttrs instance GHC.Classes.Eq Render.Font.EvanwSdf.Model.InstanceAttrs instance Foreign.Storable.Generic.Internal.GStorable Render.Font.EvanwSdf.Model.InstanceAttrs instance Engine.Vulkan.Format.HasVkFormat Render.Font.EvanwSdf.Model.InstanceAttrs instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Font.EvanwSdf.Model.InstanceAttrs module Render.ForwardMsaa data ForwardMsaa ForwardMsaa :: RenderPass -> AllocatedImage -> AllocatedImage -> Vector Framebuffer -> Rect2D -> Vector ClearValue -> RefCounted -> ForwardMsaa [$sel:fmRenderPass:ForwardMsaa] :: ForwardMsaa -> RenderPass [$sel:fmColor:ForwardMsaa] :: ForwardMsaa -> AllocatedImage [$sel:fmDepth:ForwardMsaa] :: ForwardMsaa -> AllocatedImage [$sel:fmFrameBuffers:ForwardMsaa] :: ForwardMsaa -> Vector Framebuffer [$sel:fmRenderArea:ForwardMsaa] :: ForwardMsaa -> Rect2D [$sel:fmClear:ForwardMsaa] :: ForwardMsaa -> Vector ClearValue [$sel:fmRelease:ForwardMsaa] :: ForwardMsaa -> RefCounted allocateMsaa :: (MonadResource m, MonadVulkan env m, HasLogFunc env, HasSwapchain swapchain) => swapchain -> m ForwardMsaa updateMsaa :: (MonadResource m, MonadVulkan env m, HasLogFunc env, HasSwapchain swapchain) => swapchain -> ForwardMsaa -> m ForwardMsaa usePass :: (MonadIO io, HasRenderPass a) => a -> Word32 -> CommandBuffer -> io r -> io r instance Engine.Vulkan.Types.HasRenderPass Render.ForwardMsaa.ForwardMsaa instance Engine.Vulkan.Types.RenderPass Render.ForwardMsaa.ForwardMsaa module Render.Lit.Colored.Code vert :: Code frag :: Code module Render.Lit.Colored.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs data VertexAttrs VertexAttrs :: Vec4 -> Vec4 -> Vec2 -> Packed -> VertexAttrs [$sel:vaBaseColor:VertexAttrs] :: VertexAttrs -> Vec4 [$sel:vaEmissiveColor:VertexAttrs] :: VertexAttrs -> Vec4 [$sel:vaMetallicRoughness:VertexAttrs] :: VertexAttrs -> Vec2 [$sel:vaNormal:VertexAttrs] :: VertexAttrs -> Packed type InstanceAttrs = Transform instance Foreign.Storable.Storable Render.Lit.Colored.Model.VertexAttrs instance Engine.Vulkan.Format.HasVkFormat Render.Lit.Colored.Model.VertexAttrs instance Geomancy.Gl.Block.Block Render.Lit.Colored.Model.VertexAttrs instance GHC.Generics.Generic Render.Lit.Colored.Model.VertexAttrs instance GHC.Show.Show Render.Lit.Colored.Model.VertexAttrs instance GHC.Classes.Ord Render.Lit.Colored.Model.VertexAttrs instance GHC.Classes.Eq Render.Lit.Colored.Model.VertexAttrs module Render.Lit.Material data Material Material :: Vec4 -> Vec2 -> Vec4 -> Float -> Float -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Material [$sel:mBaseColor:Material] :: Material -> Vec4 [$sel:mMetallicRoughness:Material] :: Material -> Vec2 [$sel:mEmissive:Material] :: Material -> Vec4 [$sel:mNormalScale:Material] :: Material -> Float [$sel:mAlphaCutoff:Material] :: Material -> Float [$sel:mBaseColorTex:Material] :: Material -> Int32 [$sel:mMetallicRoughnessTex:Material] :: Material -> Int32 [$sel:mEmissiveTex:Material] :: Material -> Int32 [$sel:mNormalTex:Material] :: Material -> Int32 [$sel:mAmbientOcclusionTex:Material] :: Material -> Int32 shiftTextures :: Int32 -> Material -> Material instance GHC.Generics.Generic Render.Lit.Material.Material instance GHC.Show.Show Render.Lit.Material.Material instance GHC.Classes.Ord Render.Lit.Material.Material instance GHC.Classes.Eq Render.Lit.Material.Material instance Foreign.Storable.Generic.Internal.GStorable Render.Lit.Material.Material instance Vulkan.Zero.Zero Render.Lit.Material.Material module Render.DescSets.Set0 data Scene Scene :: Transform -> Transform -> Transform -> Transform -> Vec3 -> Vec3 -> Vec4 -> Vec4 -> Int32 -> Word32 -> Scene [$sel:sceneProjection:Scene] :: Scene -> Transform [$sel:sceneInvProjection:Scene] :: Scene -> Transform [$sel:sceneView:Scene] :: Scene -> Transform [$sel:sceneInvView:Scene] :: Scene -> Transform [$sel:sceneViewPos:Scene] :: Scene -> Vec3 [$sel:sceneViewDir:Scene] :: Scene -> Vec3 -- | 4 debug tweaks bound to Kontrol [$sel:sceneTweaks:Scene] :: Scene -> Vec4 [$sel:sceneFog:Scene] :: Scene -> Vec4 [$sel:sceneEnvCube:Scene] :: Scene -> Int32 [$sel:sceneNumLights:Scene] :: Scene -> Word32 emptyScene :: Scene allocate :: (Traversable textures, Traversable cubes, MonadVulkan env m, MonadResource m) => Tagged '[Scene] DescriptorSetLayout -> textures (Texture Flat) -> cubes (Texture CubeMap) -> Maybe (Allocated 'Coherent Sun) -> ("shadow maps" ::: Vector ImageView) -> Maybe (Allocated 'Coherent Material) -> ResourceT m (FrameResource '[Scene]) -- | Minimal viable Scene without textures and lighting. allocateEmpty :: (MonadVulkan env m, MonadResource m) => Tagged '[Scene] DescriptorSetLayout -> ResourceT m (FrameResource '[Scene]) updateSet0Ds :: (HasVulkan context, Traversable textures, Traversable cubes, MonadIO m) => context -> Tagged '[Scene] (Vector DescriptorSet) -> Allocated 'Coherent Scene -> textures (Texture Flat) -> cubes (Texture CubeMap) -> Maybe (Allocated 'Coherent Sun) -> Vector (Sampler, ImageView) -> Maybe (Allocated 'Coherent Material) -> m () mkBindings :: (Foldable samplers, Foldable textures, Foldable cubemaps) => samplers Sampler -> textures a -> cubemaps b -> Word32 -> Tagged Scene DsLayoutBindings data FrameResource (ds :: [Type]) FrameResource :: Tagged ds (Vector DescriptorSet) -> Buffer -> ObserverIO Scene -> FrameResource (ds :: [Type]) [$sel:frDescSets:FrameResource] :: FrameResource (ds :: [Type]) -> Tagged ds (Vector DescriptorSet) [$sel:frBuffer:FrameResource] :: FrameResource (ds :: [Type]) -> Buffer [$sel:frObserver:FrameResource] :: FrameResource (ds :: [Type]) -> ObserverIO Scene extendResourceDS :: FrameResource ds -> Tagged ext DescriptorSet -> FrameResource (Extend ds ext) type Buffer = Allocated 'Coherent Scene -- | A process that will assemble Scene values. type Process = Merge Scene observe :: MonadUnliftIO m => Process -> FrameResource ds -> m () withBoundSet0 :: MonadIO m => FrameResource ds -> Pipeline ds vertices instances -> CommandBuffer -> Bound ds Void Void m b -> m b instance GHC.Generics.Generic Render.DescSets.Set0.Scene instance GHC.Show.Show Render.DescSets.Set0.Scene instance Foreign.Storable.Generic.Internal.GStorable Render.DescSets.Set0.Scene module Render.Lit.Colored.Pipeline type Pipeline = Pipeline '[Scene] Vertex InstanceAttrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateBlend :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config configBlend :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Font.EvanwSdf.Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config type Pipeline = Pipeline '[Scene] () InstanceAttrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline stageCode :: StageCode stageSpirv :: StageSpirv module Render.DepthOnly.Pipeline type Pipeline = Pipeline '[Scene] (Vertex3d ()) Transform allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Lit.Material.Code vert :: Code frag :: Code module Render.Lit.Material.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs data VertexAttrs VertexAttrs :: Vec2 -> Vec2 -> Packed -> Packed -> Word32 -> VertexAttrs [$sel:vaTexCoord0:VertexAttrs] :: VertexAttrs -> Vec2 [$sel:vaTexCoord1:VertexAttrs] :: VertexAttrs -> Vec2 [$sel:vaNormal:VertexAttrs] :: VertexAttrs -> Packed [$sel:vaTangent:VertexAttrs] :: VertexAttrs -> Packed [$sel:vaMaterial:VertexAttrs] :: VertexAttrs -> Word32 type InstanceAttrs = Transform data Material instance Foreign.Storable.Storable Render.Lit.Material.Model.VertexAttrs instance Engine.Vulkan.Format.HasVkFormat Render.Lit.Material.Model.VertexAttrs instance Geomancy.Gl.Block.Block Render.Lit.Material.Model.VertexAttrs instance GHC.Generics.Generic Render.Lit.Material.Model.VertexAttrs instance GHC.Show.Show Render.Lit.Material.Model.VertexAttrs instance GHC.Classes.Ord Render.Lit.Material.Model.VertexAttrs instance GHC.Classes.Eq Render.Lit.Material.Model.VertexAttrs module Render.Lit.Material.Pipeline type Pipeline = Pipeline '[Scene] Vertex InstanceAttrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateBlend :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config configBlend :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Lit.Textured.Code vert :: Code frag :: Code module Render.Pass.Compose -- | Compositionpostprocessingpresentation pass -- -- Can be used to transfer images from -- Render.Pass.Offscreen.Offscreen passes and tonemapping. -- -- Color attachments are derived from swapchain. The pass optmized for -- image transfer: it has no depth attachment and does not clear. Use -- image blitting that convers the whole area or a fullscreen shader. data Compose Compose :: RenderPass -> Vector Framebuffer -> Rect2D -> Vector ClearValue -> RefCounted -> Compose [$sel:renderPass:Compose] :: Compose -> RenderPass [$sel:frameBuffers:Compose] :: Compose -> Vector Framebuffer [$sel:renderArea:Compose] :: Compose -> Rect2D [$sel:clear:Compose] :: Compose -> Vector ClearValue [$sel:release:Compose] :: Compose -> RefCounted allocate :: (MonadResource m, MonadVulkan env m, HasLogFunc env, HasSwapchain swapchain) => swapchain -> m Compose update :: (MonadResource m, MonadVulkan env m, HasSwapchain swapchain) => swapchain -> Compose -> m Compose usePass :: (MonadIO io, HasRenderPass a) => a -> Word32 -> CommandBuffer -> io r -> io r instance Engine.Vulkan.Types.HasRenderPass Render.Pass.Compose.Compose instance Engine.Vulkan.Types.RenderPass Render.Pass.Compose.Compose module Render.ShadowMap.Code vert :: Code module Render.ShadowMap.Pipeline data Settings Settings :: CullModeFlagBits -> Maybe (Float, Float) -> Settings [$sel:cull:Settings] :: Settings -> CullModeFlagBits [$sel:depthBias:Settings] :: Settings -> Maybe (Float, Float) defaults :: Settings type Pipeline = Pipeline '[Sun] (Vertex3d ()) Transform allocate :: (HasVulkan env, HasRenderPass renderpass) => Tagged Sun DsLayoutBindings -> renderpass -> Settings -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Sun DsLayoutBindings -> Settings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.ShadowMap.RenderPass data ShadowMap ShadowMap :: RenderPass -> AllocatedImage -> Framebuffer -> Rect2D -> Extent2D -> Word32 -> Vector ClearValue -> RefCounted -> ShadowMap [$sel:smRenderPass:ShadowMap] :: ShadowMap -> RenderPass [$sel:smDepthImage:ShadowMap] :: ShadowMap -> AllocatedImage [$sel:smFrameBuffer:ShadowMap] :: ShadowMap -> Framebuffer [$sel:smRenderArea:ShadowMap] :: ShadowMap -> Rect2D [$sel:smExtent:ShadowMap] :: ShadowMap -> Extent2D [$sel:smLayerCount:ShadowMap] :: ShadowMap -> Word32 [$sel:smClear:ShadowMap] :: ShadowMap -> Vector ClearValue [$sel:smRelease:ShadowMap] :: ShadowMap -> RefCounted allocate :: (MonadResource m, MonadVulkan env m, HasLogFunc env, HasSwapchain context) => context -> Word32 -> ("light count" ::: Word32) -> m ShadowMap usePass :: (MonadIO io, HasRenderPass a) => a -> Word32 -> CommandBuffer -> io r -> io r instance Engine.Vulkan.Types.HasRenderPass Render.ShadowMap.RenderPass.ShadowMap instance Engine.Vulkan.Types.RenderPass Render.ShadowMap.RenderPass.ShadowMap module Render.Skybox.Code vert :: Code frag :: Code module Render.Skybox.Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config type Pipeline = Pipeline '[Scene] () () allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline stageCode :: StageCode stageSpirv :: StageSpirv module Render.Unlit.Colored.Code vert :: Code frag :: Code module Render.Unlit.Colored.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs type VertexAttrs = "RGBA" ::: Vec4 rgbF :: Float -> Float -> Float -> VertexAttrs black :: VertexAttrs white :: VertexAttrs type InstanceAttrs = Transform module Render.Unlit.Colored.Pipeline type Pipeline = Pipeline '[Scene] Vertex InstanceAttrs allocate :: (HasVulkan env, HasRenderPass renderpass) => Bool -> SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateWireframe :: (HasVulkan env, HasRenderPass renderpass) => Bool -> SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Bool -> Tagged Scene DsLayoutBindings -> Config configWireframe :: Bool -> Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Unlit.Line2d.Code vert :: Code frag :: Code module Render.Unlit.Line2d.Model type Segment = Allocated 'Staged Packed type Vertex = Vertex3d () createVertices :: MonadVulkan env m => Maybe Text -> Queues CommandPool -> Float -> m Segment -- | Generate mesh for the round joints / round caps special case. -- -- With a bit of vertex shader code it allows drawing a batch of smooth -- lines in one call. verticesRoundRound :: Float -> Vector Packed type Points = Vector InstanceAttrs point :: Float -> Vec4 -> Vec2 -> InstanceAttrs data InstanceAttrs InstanceAttrs :: Vec4 -> Packed -> Float -> InstanceAttrs [$sel:color:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:position:InstanceAttrs] :: InstanceAttrs -> Packed [$sel:width:InstanceAttrs] :: InstanceAttrs -> Float type Buffer s = Allocated s InstanceAttrs type Observer = ObserverCoherent InstanceAttrs observeCoherentResize_ :: (MonadVulkan env m, HasOutput source, GetOutput source ~ Vector output, Storable output) => source -> ObserverCoherent output -> m () newtype Batches v a Batches :: [v a] -> Batches v a type BatchObserver = ObserverIO (Buffer 'Coherent, Ranges) newBatchObserver :: (MonadVulkan env m, MonadResource m) => ("initial size" ::: Int) -> m BatchObserver observeCoherentBatches :: (GetOutput output ~ Batches Vector InstanceAttrs, HasOutput output, MonadVulkan env m) => output -> BatchObserver -> m () instance GHC.Generics.Generic Render.Unlit.Line2d.Model.InstanceAttrs instance GHC.Show.Show Render.Unlit.Line2d.Model.InstanceAttrs instance GHC.Classes.Eq Render.Unlit.Line2d.Model.InstanceAttrs instance GHC.Base.Monoid (Render.Unlit.Line2d.Model.Batches v a) instance GHC.Base.Semigroup (Render.Unlit.Line2d.Model.Batches v a) instance Data.Traversable.Traversable v => Data.Traversable.Traversable (Render.Unlit.Line2d.Model.Batches v) instance Data.Foldable.Foldable v => Data.Foldable.Foldable (Render.Unlit.Line2d.Model.Batches v) instance GHC.Base.Functor v => GHC.Base.Functor (Render.Unlit.Line2d.Model.Batches v) instance GHC.Classes.Ord (v a) => GHC.Classes.Ord (Render.Unlit.Line2d.Model.Batches v a) instance GHC.Show.Show (v a) => GHC.Show.Show (Render.Unlit.Line2d.Model.Batches v a) instance GHC.Classes.Eq (v a) => GHC.Classes.Eq (Render.Unlit.Line2d.Model.Batches v a) instance Foreign.Storable.Generic.Internal.GStorable Render.Unlit.Line2d.Model.InstanceAttrs instance Engine.Vulkan.Format.HasVkFormat Render.Unlit.Line2d.Model.InstanceAttrs instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Unlit.Line2d.Model.InstanceAttrs module Render.Unlit.Line2d.Draw batch :: (MonadIO m, Foldable t) => CommandBuffer -> Segment -> Allocated s InstanceAttrs -> t ("firstInstance" ::: Word32, "instanceCount" ::: Word32) -> Bound dsl vertices instances m () single :: MonadIO m => CommandBuffer -> Segment -> Allocated s InstanceAttrs -> Bound dsl vertices instances m () bind :: MonadIO io => CommandBuffer -> Segment -> Buffer s -> io () segments :: MonadIO io => CommandBuffer -> Allocated s a -> ("firstInstance" ::: Word32, "instanceCount" ::: Word32) -> io () module Render.Unlit.Line2d.Pipeline type Pipeline = Pipeline '[Scene] Vertex InstanceAttrs allocate :: (MonadVulkan env m, MonadResource m, HasRenderPass renderpass) => Bool -> SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT m Pipeline type Config = Configure Pipeline config :: Bool -> Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Unlit.Sprite.Code vert :: Code frag :: Code module Render.Unlit.Sprite.Model data InstanceAttrs InstanceAttrs :: Vec4 -> Vec4 -> Vec4 -> Vec4 -> Vec4 -> UVec2 -> Int32 -> Int32 -> InstanceAttrs [$sel:vertRect:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:fragRect:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:tint:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:outline:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:animation:InstanceAttrs] :: InstanceAttrs -> Vec4 [$sel:textureSize:InstanceAttrs] :: InstanceAttrs -> UVec2 [$sel:samplerId:InstanceAttrs] :: InstanceAttrs -> Int32 [$sel:textureId:InstanceAttrs] :: InstanceAttrs -> Int32 type StorableAttrs = Vector InstanceAttrs type InstanceBuffer stage = Allocated stage InstanceAttrs fromTexture :: Int32 -> Int32 -> Vec2 -> Vec2 -> InstanceAttrs fromAtlas :: Int32 -> Atlas -> Vec2 -> Vec2 -> Vec2 -> InstanceAttrs -- | Simple animation controller with left-to-right linear cycle. animate_ :: ("margin" ::: Float) -> ("num.frames" ::: Int) -> ("frame duration" ::: Float) -> ("phase" ::: Float) -> InstanceAttrs -> InstanceAttrs instance GHC.Generics.Generic Render.Unlit.Sprite.Model.InstanceAttrs instance GHC.Show.Show Render.Unlit.Sprite.Model.InstanceAttrs instance Foreign.Storable.Generic.Internal.GStorable Render.Unlit.Sprite.Model.InstanceAttrs instance Vulkan.Zero.Zero Render.Unlit.Sprite.Model.InstanceAttrs instance Engine.Vulkan.Format.HasVkFormat Render.Unlit.Sprite.Model.InstanceAttrs instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Unlit.Sprite.Model.InstanceAttrs module Render.Unlit.Sprite.Pipeline type Pipeline = Pipeline '[Scene] () InstanceAttrs type Config = Configure Pipeline config :: Maybe Float -> Bool -> Tagged Scene DsLayoutBindings -> Config allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Maybe Float -> Bool -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline stageCode :: StageCode stageSpirv :: StageSpirv module Render.Unlit.Textured.Code vert :: Code frag :: Code module Render.Unlit.Textured.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs type VertexAttrs = "uv" ::: Vec2 data AttrsF f Attrs :: HKD f TextureParams -> HKD f Transform -> AttrsF f [$sel:params:Attrs] :: AttrsF f -> HKD f TextureParams [$sel:transforms:Attrs] :: AttrsF f -> HKD f Transform type Attrs = AttrsF Identity attrs :: Int32 -> Int32 -> [Transform] -> Attrs type Stores = AttrsF Vector attrStores :: Foldable t => t Attrs -> Stores stores1 :: Int32 -> Int32 -> [Transform] -> Stores type Buffers = AttrsF (Allocated 'Coherent) data TextureParams TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams [$sel:tpScale:TextureParams] :: TextureParams -> Vec2 [$sel:tpOffset:TextureParams] :: TextureParams -> Vec2 [$sel:tpGamma:TextureParams] :: TextureParams -> Vec4 [$sel:tpSamplerId:TextureParams] :: TextureParams -> Int32 [$sel:tpTextureId:TextureParams] :: TextureParams -> Int32 type ObserverCoherent = ObserverIO Buffers instance Foreign.Storable.Storable Render.Unlit.Textured.Model.TextureParams instance Geomancy.Gl.Block.Block Render.Unlit.Textured.Model.TextureParams instance GHC.Show.Show Render.Unlit.Textured.Model.TextureParams instance GHC.Generics.Generic Render.Unlit.Textured.Model.TextureParams instance GHC.Generics.Generic (Render.Unlit.Textured.Model.AttrsF f) instance GHC.Show.Show Render.Unlit.Textured.Model.Attrs instance GHC.Show.Show Render.Unlit.Textured.Model.Stores instance GHC.Show.Show Render.Unlit.Textured.Model.Buffers instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Unlit.Textured.Model.Attrs instance Resource.Model.HasVertexBuffers Render.Unlit.Textured.Model.Buffers instance Vulkan.Zero.Zero Render.Unlit.Textured.Model.Attrs instance Resource.Model.Observer.UpdateCoherent Render.Unlit.Textured.Model.Buffers Render.Unlit.Textured.Model.Stores instance Resource.Model.Observer.VertexBuffers Render.Unlit.Textured.Model.Buffers instance Vulkan.Zero.Zero Render.Unlit.Textured.Model.TextureParams instance Engine.Vulkan.Format.HasVkFormat Render.Unlit.Textured.Model.TextureParams module Render.Lit.Textured.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs data VertexAttrs VertexAttrs :: Vec2 -> Packed -> VertexAttrs [$sel:vaTexCoord:VertexAttrs] :: VertexAttrs -> Vec2 [$sel:vaNormal:VertexAttrs] :: VertexAttrs -> Packed data TextureParams TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams [$sel:tpScale:TextureParams] :: TextureParams -> Vec2 [$sel:tpOffset:TextureParams] :: TextureParams -> Vec2 [$sel:tpGamma:TextureParams] :: TextureParams -> Vec4 [$sel:tpSamplerId:TextureParams] :: TextureParams -> Int32 [$sel:tpTextureId:TextureParams] :: TextureParams -> Int32 type ObserverCoherent = ObserverIO Buffers type Buffers = AttrsF (Allocated 'Coherent) type Stores = AttrsF Vector type Attrs = AttrsF Identity data AttrsF f Attrs :: HKD f TextureParams -> HKD f Transform -> AttrsF f [$sel:params:Attrs] :: AttrsF f -> HKD f TextureParams [$sel:transforms:Attrs] :: AttrsF f -> HKD f Transform attrs :: Int32 -> Int32 -> [Transform] -> Attrs attrStores :: Foldable t => t Attrs -> Stores stores1 :: Int32 -> Int32 -> [Transform] -> Stores instance Engine.Vulkan.Format.HasVkFormat Render.Lit.Textured.Model.VertexAttrs instance GHC.Generics.Generic Render.Lit.Textured.Model.VertexAttrs instance GHC.Show.Show Render.Lit.Textured.Model.VertexAttrs instance GHC.Classes.Ord Render.Lit.Textured.Model.VertexAttrs instance GHC.Classes.Eq Render.Lit.Textured.Model.VertexAttrs instance Foreign.Storable.Generic.Internal.GStorable Render.Lit.Textured.Model.VertexAttrs module Render.Lit.Textured.Pipeline type Pipeline = Pipeline '[Scene] Vertex Attrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateBlend :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config configBlend :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Debug.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs type VertexAttrs = "uv" ::: Vec2 data AttrsF f Attrs :: HKD f TextureParams -> HKD f Transform -> AttrsF f [$sel:params:Attrs] :: AttrsF f -> HKD f TextureParams [$sel:transforms:Attrs] :: AttrsF f -> HKD f Transform type Attrs = AttrsF Identity attrs :: Int32 -> Int32 -> [Transform] -> Attrs type Stores = AttrsF Vector stores1 :: Int32 -> Int32 -> [Transform] -> Stores type Buffers = AttrsF (Allocated 'Coherent) data TextureParams TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams [$sel:tpScale:TextureParams] :: TextureParams -> Vec2 [$sel:tpOffset:TextureParams] :: TextureParams -> Vec2 [$sel:tpGamma:TextureParams] :: TextureParams -> Vec4 [$sel:tpSamplerId:TextureParams] :: TextureParams -> Int32 [$sel:tpTextureId:TextureParams] :: TextureParams -> Int32 type ObserverCoherent = ObserverIO Buffers instance GHC.Generics.Generic (Render.Debug.Model.AttrsF f) instance GHC.Show.Show Render.Debug.Model.Attrs instance GHC.Show.Show Render.Debug.Model.Stores instance GHC.Show.Show Render.Debug.Model.Buffers instance Resource.Model.Observer.VertexBuffers Render.Debug.Model.Buffers instance Resource.Model.Observer.UpdateCoherent Render.Debug.Model.Buffers Render.Debug.Model.Stores instance Resource.Model.HasVertexBuffers Render.Debug.Model.Buffers instance Foreign.Storable.Generic.Internal.GStorable Render.Debug.Model.Attrs instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Debug.Model.Attrs instance Vulkan.Zero.Zero Render.Debug.Model.Attrs module Render.Debug.Pipeline type Config = Configure Pipeline config :: Mode -> Tagged Scene DsLayoutBindings -> Config type Pipeline = Pipeline '[Scene] Vertex Attrs allocate :: (HasVulkan env, HasRenderPass renderpass) => Mode -> SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline data Mode UV :: Mode Texture :: Mode Shadow :: Word32 -> Mode stageCode :: StageCode stageSpirv :: StageSpirv instance GHC.Show.Show Render.Debug.Pipeline.Mode instance GHC.Classes.Ord Render.Debug.Pipeline.Mode instance GHC.Classes.Eq Render.Debug.Pipeline.Mode instance Engine.Vulkan.Shader.Specialization Render.Debug.Pipeline.Mode module Render.Unlit.Textured.Pipeline type Pipeline = Pipeline '[Scene] Vertex Attrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateBlend :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config configBlend :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode stageSpirv :: StageSpirv module Render.Unlit.TileMap.Code vert :: Code frag :: Code module Render.Unlit.TileMap.Model type Model buf = Indexed buf Packed VertexAttrs type Vertex = Vertex3d VertexAttrs type VertexAttrs = "uv" ::: Vec2 data AttrsF f Attrs :: HKD f TileMapParams -> HKD f Transform -> AttrsF f [$sel:params:Attrs] :: AttrsF f -> HKD f TileMapParams [$sel:transforms:Attrs] :: AttrsF f -> HKD f Transform type Attrs = AttrsF Identity type Stores = AttrsF Vector type Buffers = AttrsF (Allocated 'Coherent) data TileMapParams TileMapParams :: IVec4 -> Vec2 -> Vec2 -> Vec2 -> Vec2 -> Vec2 -> Vec2 -> Vec2 -> TileMapParams [$sel:tmpTextureIds:TileMapParams] :: TileMapParams -> IVec4 [$sel:tmpViewOffset:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpViewportSize:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpMapTextureSize:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpTilesetTextureSize:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpTileSize:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpTilesetOffset:TileMapParams] :: TileMapParams -> Vec2 [$sel:tmpTilesetBorder:TileMapParams] :: TileMapParams -> Vec2 type ObserverCoherent = ObserverIO Buffers instance Engine.Vulkan.Format.HasVkFormat Render.Unlit.TileMap.Model.TileMapParams instance GHC.Show.Show Render.Unlit.TileMap.Model.TileMapParams instance GHC.Generics.Generic Render.Unlit.TileMap.Model.TileMapParams instance GHC.Generics.Generic (Render.Unlit.TileMap.Model.AttrsF f) instance GHC.Show.Show Render.Unlit.TileMap.Model.Attrs instance GHC.Show.Show Render.Unlit.TileMap.Model.Stores instance GHC.Show.Show Render.Unlit.TileMap.Model.Buffers instance Engine.Vulkan.Pipeline.Graphics.HasVertexInputBindings Render.Unlit.TileMap.Model.Attrs instance Resource.Model.HasVertexBuffers Render.Unlit.TileMap.Model.Buffers instance Resource.Model.Observer.UpdateCoherent Render.Unlit.TileMap.Model.Buffers Render.Unlit.TileMap.Model.Stores instance Resource.Model.Observer.VertexBuffers Render.Unlit.TileMap.Model.Buffers instance Foreign.Storable.Generic.Internal.GStorable Render.Unlit.TileMap.Model.TileMapParams instance Vulkan.Zero.Zero Render.Unlit.TileMap.Model.TileMapParams module Render.Unlit.TileMap.Pipeline type Pipeline = Pipeline '[Scene] Vertex Attrs allocate :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline allocateBlend :: (HasVulkan env, HasRenderPass renderpass) => SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> renderpass -> ResourceT (RIO env) Pipeline type Config = Configure Pipeline config :: Tagged Scene DsLayoutBindings -> Config configBlend :: Tagged Scene DsLayoutBindings -> Config stageCode :: StageCode -- | All the provided render passes and pipelines packaged and delivered. module Render.Basic type Stage = Stage RenderPasses Pipelines type Frame = Frame RenderPasses Pipelines type StageFrameRIO r s a = StageFrameRIO RenderPasses Pipelines r s a -- | Basic rendering component without any extensions. type Rendering = Rendering RenderPasses Pipelines -- | Basic rendering component without any extensions and resources. rendering_ :: Rendering st data RenderPasses RenderPasses :: ForwardMsaa -> ShadowMap -> RenderPasses [$sel:rpForwardMsaa:RenderPasses] :: RenderPasses -> ForwardMsaa [$sel:rpShadowPass:RenderPasses] :: RenderPasses -> ShadowMap data Settings Settings :: Word32 -> Word32 -> Settings [$sel:sShadowSize:Settings] :: Settings -> Word32 [$sel:sShadowLayers:Settings] :: Settings -> Word32 allocate :: (HasSwapchain swapchain, HasLogFunc env, HasVulkan env) => Settings -> swapchain -> ResourceT (RIO env) RenderPasses allocate_ :: (HasSwapchain swapchain, HasLogFunc env, HasVulkan env) => swapchain -> ResourceT (RIO env) RenderPasses type Pipelines = PipelinesF Identity type PipelineObservers = PipelinesF Observers type PipelineWorkers = PipelinesF ConfigureGraphics data PipelinesF (f :: Type -> Type) Pipelines :: SampleCountFlagBits -> Tagged Scene DsLayoutBindings -> Tagged '[Scene] DescriptorSetLayout -> Tagged Sun DsLayoutBindings -> Tagged '[Sun] DescriptorSetLayout -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> (f ^ Pipeline) -> PipelinesF (f :: Type -> Type) [$sel:pMSAA:Pipelines] :: PipelinesF (f :: Type -> Type) -> SampleCountFlagBits [$sel:pSceneBinds:Pipelines] :: PipelinesF (f :: Type -> Type) -> Tagged Scene DsLayoutBindings [$sel:pSceneLayout:Pipelines] :: PipelinesF (f :: Type -> Type) -> Tagged '[Scene] DescriptorSetLayout [$sel:pShadowBinds:Pipelines] :: PipelinesF (f :: Type -> Type) -> Tagged Sun DsLayoutBindings [$sel:pShadowLayout:Pipelines] :: PipelinesF (f :: Type -> Type) -> Tagged '[Sun] DescriptorSetLayout [$sel:pEvanwSdf:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pSkybox:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pDebugUV:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pDebugTexture:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pDebugShadow:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pDepthOnly:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitColored:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitColoredBlend:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitMaterial:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitMaterialBlend:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitTextured:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLitTexturedBlend:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pUnlitColored:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pUnlitColoredNoDepth:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pUnlitTextured:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pUnlitTexturedBlend:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLine2d:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pLine2dNoDepth:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pSprite:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pSpriteOutline:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pTileMap:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pTileMapBlend:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pWireframe:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pWireframeNoDepth:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline [$sel:pShadowCast:Pipelines] :: PipelinesF (f :: Type -> Type) -> f ^ Pipeline allocatePipelines_ :: HasSwapchain swapchain => swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines allocatePipelines :: Tagged Scene DsLayoutBindings -> SampleCountFlagBits -> RenderPasses -> ResourceT (StageRIO st) Pipelines allocateWorkers :: Tagged Scene DsLayoutBindings -> SampleCountFlagBits -> RenderPasses -> ResourceT (StageRIO st) PipelineWorkers allocateObservers :: RenderPasses -> PipelineWorkers -> ResourceT (StageRIO rs) PipelineObservers observePipelines :: RenderPasses -> PipelineWorkers -> PipelineObservers -> StageFrameRIO rp p fr rs () getSceneLayout :: PipelinesF f -> Tagged '[Scene] DescriptorSetLayout getSunLayout :: Pipelines -> Tagged '[Sun] DescriptorSetLayout shaderDir :: FilePath stageSources :: Map Text StageCode instance GHC.Show.Show Render.Basic.Settings instance GHC.Classes.Eq Render.Basic.Settings instance Vulkan.Zero.Zero Render.Basic.Settings instance Engine.Vulkan.Types.RenderPass Render.Basic.RenderPasses -- | JSON font loader for bitmaps and SDFs -- -- Generator: https://evanw.github.io/font-texture-generator/ -- -- Usage (WebGL): -- https://evanw.github.io/font-texture-generator/example-webgl/ module Resource.Font.EvanW load :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Source -> m Container data Container Container :: Text -> Float -> Bool -> Bool -> Float -> Float -> HashMap Char Character -> Container [$sel:name:Container] :: Container -> Text [$sel:size:Container] :: Container -> Float [$sel:bold:Container] :: Container -> Bool [$sel:italic:Container] :: Container -> Bool [$sel:width:Container] :: Container -> Float [$sel:height:Container] :: Container -> Float [$sel:characters:Container] :: Container -> HashMap Char Character data Character Character :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> Character [$sel:x:Character] :: Character -> Float [$sel:y:Character] :: Character -> Float [$sel:width:Character] :: Character -> Float [$sel:height:Character] :: Character -> Float [$sel:originX:Character] :: Character -> Float [$sel:originY:Character] :: Character -> Float [$sel:advance:Character] :: Character -> Float putLine :: ("WH" ::: Vec2) -> ("XY" ::: Vec2) -> ("Alignment" ::: Alignment) -> ("Size" ::: Float) -> ("Font" ::: Container) -> ("Line" ::: [Char]) -> ("scale" ::: Float, [PutChar]) data PutChar PutChar :: Vec2 -> Vec2 -> Vec2 -> Vec2 -> PutChar [$sel:pcPos:PutChar] :: PutChar -> Vec2 [$sel:pcSize:PutChar] :: PutChar -> Vec2 [$sel:pcOffset:PutChar] :: PutChar -> Vec2 [$sel:pcScale:PutChar] :: PutChar -> Vec2 instance GHC.Generics.Generic Resource.Font.EvanW.FontError instance GHC.Show.Show Resource.Font.EvanW.FontError instance GHC.Classes.Ord Resource.Font.EvanW.FontError instance GHC.Classes.Eq Resource.Font.EvanW.FontError instance GHC.Generics.Generic Resource.Font.EvanW.Character instance GHC.Show.Show Resource.Font.EvanW.Character instance GHC.Classes.Ord Resource.Font.EvanW.Character instance GHC.Classes.Eq Resource.Font.EvanW.Character instance GHC.Generics.Generic Resource.Font.EvanW.Container instance GHC.Show.Show Resource.Font.EvanW.Container instance GHC.Classes.Ord Resource.Font.EvanW.Container instance GHC.Classes.Eq Resource.Font.EvanW.Container instance GHC.Show.Show Resource.Font.EvanW.PutChar instance Foreign.Storable.Storable Resource.Font.EvanW.PutChar instance Data.Aeson.Types.FromJSON.FromJSON Resource.Font.EvanW.Container instance Data.Aeson.Types.FromJSON.FromJSON Resource.Font.EvanW.Character instance GHC.Exception.Type.Exception Resource.Font.EvanW.FontError module Resource.Font data Config Config :: Source -> Source -> Config [$sel:configContainer:Config] :: Config -> Source [$sel:configTexture:Config] :: Config -> Source collectionTextures :: Foldable collection => collection Font -> Vector (Texture Flat) data Font Font :: Container -> Texture Flat -> Font [$sel:container:Font] :: Font -> Container [$sel:texture:Font] :: Font -> Texture Flat allocate :: (HasCallStack, MonadVulkan env m, HasLogFunc env, MonadThrow m, MonadResource m) => Queues CommandPool -> Config -> m Font instance GHC.Show.Show Resource.Font.Config module Engine.UI.Message type Process = Merge (Vector InstanceAttrs) data Input Input :: Text -> Int32 -> Container -> Alignment -> Float -> Vec4 -> Vec4 -> Float -> Float -> Input [$sel:inputText:Input] :: Input -> Text [$sel:inputFontId:Input] :: Input -> Int32 [$sel:inputFont:Input] :: Input -> Container [$sel:inputOrigin:Input] :: Input -> Alignment [$sel:inputSize:Input] :: Input -> Float [$sel:inputColor:Input] :: Input -> Vec4 [$sel:inputOutline:Input] :: Input -> Vec4 [$sel:inputOutlineWidth:Input] :: Input -> Float [$sel:inputSmoothing:Input] :: Input -> Float spawn :: (MonadResource m, MonadUnliftIO m, HasOutput box, GetOutput box ~ Box, HasOutput input, GetOutput input ~ Input) => box -> input -> m Process spawnFromR :: (MonadResource m, MonadUnliftIO m, HasOutput box, GetOutput box ~ Box, HasOutput source) => box -> source -> (GetOutput source -> Input) -> m Process mkAttrs :: Box -> Input -> Vector InstanceAttrs type Observer = ObserverIO Buffer type Buffer = Allocated 'Coherent InstanceAttrs newObserver :: Int -> ResourceT (StageRIO st) Observer observe :: (MonadVulkan env m, HasOutput source, GetOutput source ~ Vector InstanceAttrs) => source -> Observer -> m () module Resource.Mesh.Lit type MaterialNodes = Vector MaterialNode data MaterialNode MaterialNode :: Node -> Int -> Material -> MaterialNode [$sel:mnNode:MaterialNode] :: MaterialNode -> Node [$sel:mnMaterialIx:MaterialNode] :: MaterialNode -> Int [$sel:mnMaterial:MaterialNode] :: MaterialNode -> Material instance GHC.Generics.Generic Resource.Mesh.Lit.MaterialNode instance GHC.Show.Show Resource.Mesh.Lit.MaterialNode instance GHC.Classes.Eq Resource.Mesh.Lit.MaterialNode instance Foreign.Storable.Generic.Internal.GStorable Resource.Mesh.Lit.MaterialNode instance Resource.Mesh.Types.HasRange Resource.Mesh.Lit.MaterialNode module Render.Lit.Material.Collect type LoadedModel = (Meta, Vector MaterialNode, Model 'Staged) data SceneModel models textures SceneModel :: Text -> (models -> LoadedModel) -> (textures -> Int32) -> SceneModel models textures [$sel:smLabel:SceneModel] :: SceneModel models textures -> Text [$sel:smGetModel:SceneModel] :: SceneModel models textures -> models -> LoadedModel [$sel:smGetTextureOffset:SceneModel] :: SceneModel models textures -> textures -> Int32 sceneMaterials :: Foldable t => models -> textures -> t (SceneModel models textures) -> Vector Material modelMaterials :: Foldable t => Text -> Int32 -> (Map Text (Set Int), Map Int (Text, Material)) -> t MaterialNode -> (Map Text (Set Int), Map Int (Text, Material)) nodeMaterials :: Text -> Int32 -> MaterialNode -> (Map Text (Set Int), Map Int (Text, Material)) -> (Map Text (Set Int), Map Int (Text, Material)) module Stage.Loader.Scene type Process = Merge Scene spawn :: (MonadResource m, MonadUnliftIO m, HasOutput projection, GetOutput projection ~ Projection 'Orthographic) => projection -> m Process module Stage.Loader.UI data Settings fonts textures Settings :: Text -> Int32 -> Int32 -> Collection textures fonts (Int32, Texture Flat) -> fonts Container -> (forall a. fonts a -> a) -> (forall a. fonts a -> a) -> Settings fonts textures [$sel:titleMessage:Settings] :: Settings fonts textures -> Text [$sel:backgroundIx:Settings] :: Settings fonts textures -> Int32 [$sel:spinnerIx:Settings] :: Settings fonts textures -> Int32 [$sel:combined:Settings] :: Settings fonts textures -> Collection textures fonts (Int32, Texture Flat) [$sel:fonts:Settings] :: Settings fonts textures -> fonts Container [$sel:smallFont:Settings] :: Settings fonts textures -> forall a. fonts a -> a [$sel:largeFont:Settings] :: Settings fonts textures -> forall a. fonts a -> a data UI UI :: Process -> Process -> Var Input -> Process -> Merge Stores -> Merge Stores -> Model 'Staged -> UI [$sel:titleP:UI] :: UI -> Process [$sel:subtitleP:UI] :: UI -> Process [$sel:progressInput:UI] :: UI -> Var Input [$sel:progressP:UI] :: UI -> Process [$sel:backgroundP:UI] :: UI -> Merge Stores [$sel:spinnerP:UI] :: UI -> Merge Stores [$sel:quadUV:UI] :: UI -> Model 'Staged spawn :: Queues CommandPool -> BoxProcess -> Settings fonts textures -> StageRIO env (ReleaseKey, UI) data Observer Observer :: [Observer] -> ObserverCoherent -> ObserverCoherent -> Observer [$sel:messages:Observer] :: Observer -> [Observer] [$sel:background:Observer] :: Observer -> ObserverCoherent [$sel:spinner:Observer] :: Observer -> ObserverCoherent newObserver :: UI -> ResourceT (StageRIO st) Observer observe :: HasVulkan env => UI -> Observer -> RIO env () module Stage.Loader.Types type Stage = Stage FrameResources RunState type Frame = Frame FrameResources data FrameResources FrameResources :: FrameResource '[Scene] -> Observer -> FrameResources [$sel:frSceneUi:FrameResources] :: FrameResources -> FrameResource '[Scene] [$sel:frUI:FrameResources] :: FrameResources -> Observer data RunState RunState :: Process -> UI -> RunState [$sel:rsSceneUiP:RunState] :: RunState -> Process [$sel:rsUI:RunState] :: RunState -> UI module Stage.Loader.Render updateBuffers :: RunState -> FrameResources -> StageFrameRIO FrameResources RunState () recordCommands :: CommandBuffer -> FrameResources -> Word32 -> StageFrameRIO FrameResources RunState () module Stage.Loader.Setup bootstrap :: Text -> (Config, Config) -> (Source, Source) -> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded) -> (loaded -> StackStage) -> (Setup Vector Vector loaded -> StackStage, StageSetupRIO (Setup Vector Vector loaded)) stackStage :: (Traversable fonts, Traversable textures) => ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded) -> (loaded -> StackStage) -> Settings textures fonts -> StackStage