Skip to content

Commit 2eecb20

Browse files
dpwizdpwiz
committed
Add renderpassless example
1 parent 2278b57 commit 2eecb20

9 files changed

Lines changed: 444 additions & 39 deletions

File tree

‎examples/lib/Triangle.hs‎

Lines changed: 40 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
{-# LANGUAGE OverloadedLists #-}
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE QuasiQuotes #-}
4-
{-# OPTIONS_GHC -Wno-name-shadowing #-}
54

65
{-| Backend-independent triangle renderer using the recycling 'Frame' loop
76
from "Frame". Each backend (SDL2, GLFW) builds a 'VulkanContext' + an initial
@@ -10,9 +9,12 @@ quit", and hands off to 'runTriangle'.
109
-}
1110
module Triangle
1211
( runTriangle
12+
, vertCode
13+
, fragCode
1314
) where
1415

1516
import Control.Monad.Trans.Resource (MonadResource, ReleaseKey, ResourceT)
17+
import Data.ByteString (ByteString)
1618
import Data.Vector (Vector)
1719
import qualified Data.Vector as V
1820
import qualified Vulkan.Core10 as Vk
@@ -123,39 +125,40 @@ createGraphicsPipeline dev renderPass =
123125
[ (Vk.SHADER_STAGE_VERTEX_BIT, vertCode)
124126
, (Vk.SHADER_STAGE_FRAGMENT_BIT, fragCode)
125127
]
126-
where
127-
vertCode =
128-
[vert|
129-
#version 450
130-
#extension GL_ARB_separate_shader_objects : enable
131-
132-
layout(location = 0) out vec3 fragColor;
133-
134-
vec2 positions[3] = vec2[](
135-
vec2(0.0, -0.5),
136-
vec2(0.5, 0.5),
137-
vec2(-0.5, 0.5)
138-
);
139-
vec3 colors[3] = vec3[](
140-
vec3(1.0, 1.0, 0.0),
141-
vec3(0.0, 1.0, 1.0),
142-
vec3(1.0, 0.0, 1.0)
143-
);
144-
145-
void main() {
146-
gl_Position = vec4(positions[gl_VertexIndex], 0.0, 1.0);
147-
fragColor = colors[gl_VertexIndex];
148-
}
149-
|]
150-
fragCode =
151-
[frag|
152-
#version 450
153-
#extension GL_ARB_separate_shader_objects : enable
154-
155-
layout(location = 0) in vec3 fragColor;
156-
layout(location = 0) out vec4 outColor;
157-
158-
void main() {
159-
outColor = vec4(fragColor, 1.0);
160-
}
161-
|]
128+
129+
vertCode :: ByteString
130+
vertCode =
131+
[vert|
132+
#version 450
133+
134+
layout(location = 0) out vec3 fragColor;
135+
136+
vec2 positions[3] = vec2[](
137+
vec2(0.0, -0.5),
138+
vec2(0.5, 0.5),
139+
vec2(-0.5, 0.5)
140+
);
141+
vec3 colors[3] = vec3[](
142+
vec3(1.0, 1.0, 0.0),
143+
vec3(0.0, 1.0, 1.0),
144+
vec3(1.0, 0.0, 1.0)
145+
);
146+
147+
void main() {
148+
gl_Position = vec4(positions[gl_VertexIndex], 0.0, 1.0);
149+
fragColor = colors[gl_VertexIndex];
150+
}
151+
|]
152+
153+
fragCode :: ByteString
154+
fragCode =
155+
[frag|
156+
#version 450
157+
158+
layout(location = 0) in vec3 fragColor;
159+
layout(location = 0) out vec4 outColor;
160+
161+
void main() {
162+
outColor = vec4(fragColor, 1.0);
163+
}
164+
|]

‎examples/package.yaml‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,19 @@ executables:
8181
- vulkan-init-glfw
8282
- vulkan-utils
8383

84+
triangle-dynamic:
85+
main: Main.hs
86+
source-dirs: triangle-dynamic
87+
dependencies:
88+
- base <5
89+
- resourcet
90+
- text
91+
- vector
92+
- vulkan
93+
- vulkan-examples
94+
- vulkan-init-glfw
95+
- vulkan-utils
96+
8497
triangle-headless:
8598
main: Main.hs
8699
source-dirs: triangle-headless

‎examples/resize/Main.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
{-# LANGUAGE OverloadedLists #-}
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE TypeApplications #-}
4-
{-# OPTIONS_GHC -Wno-name-shadowing #-}
54

65
module Main
76
( main

‎examples/triangle-dynamic/Main.hs‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
{-# LANGUAGE QuasiQuotes #-}
2+
3+
module Main where
4+
5+
import Control.Monad.Trans.Resource (runResourceT)
6+
import Data.Text (Text)
7+
import qualified TriangleDynamic
8+
import Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering (PhysicalDeviceDynamicRenderingFeatures)
9+
import qualified Vulkan.Utils.Requirements.TH as U
10+
import Vulkan.Utils.Swapchain (defaultSwapchainConfig)
11+
import Vulkan.Zero (zero)
12+
import qualified Window.GLFW as Window
13+
import WindowedBoot (WindowedConfig (..), withWindowedVk)
14+
15+
main :: IO ()
16+
main = runResourceT $ do
17+
Window.withGLFW
18+
window <- Window.createWindow appName windowWidth windowHeight
19+
Window.showWindow window
20+
(vc, _vma, initialSC) <-
21+
withWindowedVk
22+
WindowedConfig
23+
{ wcAppName = appName
24+
, wcInstanceReqs = []
25+
, wcDeviceReqs =
26+
[U.reqs|
27+
VK_KHR_dynamic_rendering
28+
PhysicalDeviceDynamicRenderingFeatures.dynamicRendering
29+
|]
30+
, wcVmaFlags = zero
31+
, wcSwapchainConfig = defaultSwapchainConfig
32+
}
33+
(Window.glfwAdapter window)
34+
TriangleDynamic.runTriangle
35+
vc
36+
initialSC
37+
(Window.drawableSize window)
38+
(Window.shouldQuit window)
39+
40+
appName :: Text
41+
appName = "Haskell Vulkan dynamic-rendering triangle (GLFW)"
42+
43+
windowWidth, windowHeight :: Int
44+
windowWidth = 800
45+
windowHeight = 600

‎examples/triangle-dynamic/TriangleDynamic.hs‎

Lines changed: 113 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,113 @@
1+
{-# LANGUAGE OverloadedLists #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE QuasiQuotes #-}
4+
5+
{-| Dynamic-rendering version of "Triangle". Same colored triangle, same
6+
recycling-Frame loop, but with no 'Vk.RenderPass' and no 'Vk.Framebuffer':
7+
the swapchain image's layout transitions are handled by explicit pipeline
8+
barriers from "Vulkan.Utils.ImageBarrier", and the rendering region is
9+
opened with 'Vk.cmdUseRendering' against a 'Vk.RenderingInfo' that points
10+
straight at the swapchain image view.
11+
12+
The graphics pipeline is built with 'createColorPipelineDynamicFromShaders',
13+
which omits the render pass and instead carries a
14+
'Vk.PipelineRenderingCreateInfo' in its pNext chain.
15+
-}
16+
module TriangleDynamic
17+
( runTriangle
18+
) where
19+
20+
import Control.Monad.Trans.Resource (ResourceT, register)
21+
import qualified Data.Vector as V
22+
import Data.Word (Word32)
23+
import qualified Triangle
24+
import Vulkan.CStruct.Extends (SomeStruct (..))
25+
import qualified Vulkan.Core10 as Rect2D (Rect2D (..))
26+
import qualified Vulkan.Core10 as Vk
27+
import qualified Vulkan.Core13 as Vk
28+
import qualified Vulkan.Extensions.VK_KHR_surface as KHR
29+
import Vulkan.Utils.Frame (Frame (..), acquireFrameImage, presentFrameImage, queueSubmitFrame, recordCommands)
30+
import Vulkan.Utils.ImageBarrier (cmdTransitionForColorAttachment, cmdTransitionForPresent)
31+
import Vulkan.Utils.Pipeline (createColorPipelineDynamicFromShaders)
32+
import Vulkan.Utils.Swapchain (Swapchain (..))
33+
import Vulkan.Utils.VulkanContext (VulkanContext (..))
34+
import Vulkan.Utils.WindowLoop (WindowLoop (..), noOnExit, noOnFrame, runWindowLoop)
35+
import Vulkan.Zero (zero)
36+
37+
{- | Drive a recycling-Frame render loop drawing the colored triangle with
38+
'VK_KHR_dynamic_rendering'.
39+
-}
40+
runTriangle
41+
:: VulkanContext
42+
-> Swapchain
43+
-- ^ Initial swapchain
44+
-> IO Vk.Extent2D
45+
-- ^ Get current drawable size (for resize)
46+
-> IO Bool
47+
-- ^ Per-frame poller; 'True' means quit
48+
-> ResourceT IO ()
49+
runTriangle vc initialSC getDrawableSize shouldQuit = do
50+
(_, pipeline) <-
51+
createColorPipelineDynamicFromShaders
52+
(vcDevice vc)
53+
[KHR.format (sFormat initialSC)]
54+
[ (Vk.SHADER_STAGE_VERTEX_BIT, Triangle.vertCode)
55+
, (Vk.SHADER_STAGE_FRAGMENT_BIT, Triangle.fragCode)
56+
]
57+
58+
runWindowLoop
59+
vc
60+
initialSC
61+
getDrawableSize
62+
shouldQuit
63+
WindowLoop
64+
{ wlMkState = \_sc -> do
65+
k <- register (pure ())
66+
pure ((), k)
67+
, wlRender = \() -> drawTriangle vc pipeline
68+
, wlOnFrame = noOnFrame
69+
, wlOnExit = noOnExit
70+
}
71+
72+
----------------------------------------------------------------
73+
-- Per-frame draw
74+
----------------------------------------------------------------
75+
76+
drawTriangle :: VulkanContext -> Vk.Pipeline -> Frame -> ResourceT IO ()
77+
drawTriangle vc pipeline f = do
78+
(acquireResult, imageIndex) <- acquireFrameImage vc f
79+
commands <- recordCommands vc f \cb -> do
80+
let image = sImages V.! fromIntegral imageIndex
81+
cmdTransitionForColorAttachment cb image
82+
Vk.cmdUseRendering cb (renderingInfo imageIndex) do
83+
Vk.cmdSetViewport cb 0 [vp]
84+
Vk.cmdSetScissor cb 0 [area]
85+
Vk.cmdBindPipeline cb Vk.PIPELINE_BIND_POINT_GRAPHICS pipeline
86+
Vk.cmdDraw cb 3 1 0 0
87+
cmdTransitionForPresent cb image
88+
queueSubmitFrame vc f [commands]
89+
presentFrameImage vc f acquireResult imageIndex
90+
where
91+
Swapchain{sExtent, sImages, sImageViews} = fSwapchain f
92+
area = zero{Rect2D.extent = sExtent}
93+
renderingInfo :: Word32 -> Vk.RenderingInfo '[]
94+
renderingInfo imageIndex =
95+
zero
96+
{ Vk.renderArea = area
97+
, Vk.layerCount = 1
98+
, Vk.colorAttachments = [SomeStruct colorAttachment]
99+
}
100+
where
101+
colorAttachment :: Vk.RenderingAttachmentInfo '[]
102+
colorAttachment =
103+
zero
104+
{ Vk.imageView = sImageViews V.! fromIntegral imageIndex
105+
, Vk.imageLayout = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
106+
, Vk.loadOp = Vk.ATTACHMENT_LOAD_OP_CLEAR
107+
, Vk.storeOp = Vk.ATTACHMENT_STORE_OP_STORE
108+
, Vk.clearValue = Vk.Color (Vk.Float32 0.1 0.1 0.1 0)
109+
}
110+
vp :: Vk.Viewport
111+
vp = zero{Vk.width = realToFrac w, Vk.height = realToFrac h, Vk.maxDepth = 1}
112+
where
113+
Vk.Extent2D w h = sExtent

‎examples/vulkan-examples.cabal‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -447,6 +447,64 @@ executable resize
447447
if os(windows)
448448
ghc-options: -optl-mconsole
449449

450+
executable triangle-dynamic
451+
main-is: Main.hs
452+
other-modules:
453+
TriangleDynamic
454+
Paths_vulkan_examples
455+
autogen-modules:
456+
Paths_vulkan_examples
457+
hs-source-dirs:
458+
triangle-dynamic
459+
default-extensions:
460+
BlockArguments
461+
DataKinds
462+
DefaultSignatures
463+
DeriveFoldable
464+
DeriveFunctor
465+
DeriveTraversable
466+
DerivingStrategies
467+
DuplicateRecordFields
468+
FlexibleContexts
469+
FlexibleInstances
470+
GADTs
471+
GeneralizedNewtypeDeriving
472+
InstanceSigs
473+
LambdaCase
474+
MagicHash
475+
NamedFieldPuns
476+
NoMonomorphismRestriction
477+
NumDecimals
478+
OverloadedStrings
479+
PatternSynonyms
480+
PolyKinds
481+
QuantifiedConstraints
482+
RankNTypes
483+
RecordWildCards
484+
RoleAnnotations
485+
ScopedTypeVariables
486+
StandaloneDeriving
487+
Strict
488+
TupleSections
489+
TypeApplications
490+
TypeFamilyDependencies
491+
TypeOperators
492+
TypeSynonymInstances
493+
ViewPatterns
494+
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
495+
build-depends:
496+
base <5
497+
, resourcet
498+
, text
499+
, vector
500+
, vulkan
501+
, vulkan-examples
502+
, vulkan-init-glfw
503+
, vulkan-utils
504+
default-language: Haskell2010
505+
if os(windows)
506+
ghc-options: -optl-mconsole
507+
450508
executable triangle-glfw
451509
main-is: Main.hs
452510
other-modules:

0 commit comments

Comments
 (0)