├── LICENSE ├── README.md ├── cl-vulkan.asd ├── features.lisp ├── ifc ├── glfw │ ├── abstract-os-compat.lisp │ ├── glfw.lisp │ └── package.lisp ├── load-foreign-libs.lisp └── vulkan │ ├── package.lisp │ ├── s-type-table.lisp │ ├── tools │ └── generate.lisp │ ├── vk-funcs.lisp │ ├── vk-macros.lisp │ └── vk-types.lisp ├── shaders ├── comp.spv ├── frag.spv ├── shader.comp ├── shader.frag ├── shader.vert └── vert.spv └── src ├── allocation-callbacks.lisp ├── buffers.lisp ├── classes.lisp ├── cocoa.lisp ├── command-buffers.lisp ├── command-pool.lisp ├── compute-pipeline.lisp ├── debug-report.lisp ├── descriptor-pool.lisp ├── descriptor-set-layout.lisp ├── descriptor-sets.lisp ├── fence.lisp ├── framebuffer.lisp ├── graphics-pipeline.lisp ├── helpers.lisp ├── image-views.lisp ├── images.lisp ├── logical-device.lisp ├── macros.lisp ├── memory-heap.lisp ├── memory-pool.lisp ├── memory-type.lisp ├── package.lisp ├── physical-device.lisp ├── pipeline-cache.lisp ├── pipeline-layout.lisp ├── present-modes.lisp ├── queue-family.lisp ├── queue.lisp ├── render-pass.lisp ├── sampler.lisp ├── shader-module.lisp ├── spirv.lisp ├── support.lisp ├── surface-capabilities.lisp ├── surface-format.lisp ├── surface.lisp ├── swapchain.lisp ├── utilities.lisp ├── vulkan-application.lisp ├── vulkan-instance.lisp ├── win32.lisp ├── window.lisp └── x11.lisp /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019-2023 Andrew Kenneth Wolven 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cl-vulkan 2 | Vulkan bindings for Common Lisp. 3 | 4 | cl-vulkan currently supports SBCL and Clozure Common Lisp on Microsoft Windows, Linux and MacOS. 5 | 6 | cl-vulkan currently supports Vulkan 1.0 and 1.2, including compute pipelines. Vulkan 1.1 and 1.3 are coming soon. It is known to work on Nvidia, AMD, and Intel GPUs both discrete and integrated varieties. It has also been tested with Swiftshader Vulkan emulator. cl-vulkan requires the MoltenVK client driver on MacOS. cl-vulkan is intended only to be bindings plus Common Lisp convenience layer for using Vulkan. It has a rudimentary device memory pool but one is not required to use that. The demo has been removed, and as a user of cl-vulkan it is expected that you know something about Vulkan and about Common Lisp and therefore will know how to employ the bindings. Refer to the Khronos Vulkan documentation or a Vulkan tutorial for usage. 7 | 8 | cl-vulkan relies on CLUI to provide OS Windowing support. If you have a need to run compute pipelines entirely headless, please contact the author of cl-vulkan to enable support for that. cl-vulkan has been run with GLFW3 and would only require minor changes to make it use GLFW/GLUT/SDL or equivalent if those are your requirements. 9 | 10 | If you are looking for a cross-platform Common Lisp library which can readily draw graphics on the screen out of the box, take a look at KRMA instead: https://github.com/awolven/krma.git. 11 | 12 | You must edit the file ifc/load-foreign-libs.lisp to use the Vulkan SDK. 13 | -------------------------------------------------------------------------------- /cl-vulkan.asd: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | ;; todo: this should be in :objc-runtime system 23 | ;; but for now I don't want to fork that system 24 | #+(and darwin (not glfw))(cl:pushnew :objc cl:*features*) 25 | 26 | (defsystem cl-vulkan 27 | :description "Bindings for using Vulkan with Common Lisp" 28 | :depends-on (:cffi :bordeaux-threads #-glfw :clui) 29 | :author "Andrew K Wolven " 30 | :components 31 | ((:file "features") 32 | #+glfw(:file "ifc/glfw/package") 33 | #+glfw(:file "ifc/glfw/glfw") 34 | #+glfw(:file "ifc/glfw/abstract-os-compat") 35 | (:file "ifc/vulkan/package") 36 | (:file "ifc/vulkan/vk-types") 37 | (:file "ifc/vulkan/s-type-table") 38 | (:file "ifc/vulkan/vk-macros") 39 | (:file "ifc/vulkan/vk-funcs") 40 | (:file "src/package") 41 | (:file "src/utilities") 42 | (:file "src/macros") 43 | (:file "src/support") 44 | (:file "src/helpers") 45 | (:file "src/classes") 46 | (:file "src/allocation-callbacks") 47 | (:file "src/debug-report") 48 | (:file "src/pipeline-cache") 49 | (:file "src/vulkan-instance") 50 | (:file "src/physical-device") 51 | (:file "src/queue-family") 52 | (:file "src/memory-type") 53 | (:file "src/memory-heap") 54 | (:file "src/logical-device") 55 | (:file "src/fence") 56 | (:file "src/swapchain") 57 | (:file "src/memory-pool") 58 | (:file "src/vulkan-application") 59 | (:file "src/window") 60 | (:file "src/surface-format") 61 | (:file "src/surface-capabilities") 62 | (:file "src/present-modes") 63 | (:file "src/surface") 64 | (:file "src/queue") 65 | (:file "src/images") 66 | (:file "src/image-views") 67 | (:file "src/render-pass") 68 | (:file "src/descriptor-set-layout") 69 | (:file "src/pipeline-layout") 70 | (:file "src/shader-module") 71 | (:file "src/graphics-pipeline") 72 | (:file "src/compute-pipeline") 73 | (:file "src/command-pool") 74 | (:file "src/framebuffer") 75 | (:file "src/buffers") 76 | (:file "src/descriptor-pool") 77 | (:file "src/descriptor-sets") 78 | (:file "src/command-buffers") 79 | (:file "src/sampler") 80 | (:file "src/spirv") 81 | #+linux(:file "src/x11") 82 | #+os-windows(:file "src/win32") 83 | #+darwin(:file "src/cocoa") 84 | (:file "ifc/load-foreign-libs"))) 85 | 86 | -------------------------------------------------------------------------------- /features.lisp: -------------------------------------------------------------------------------- 1 | 2 | (pushnew :cl-vulkan *features*) 3 | -------------------------------------------------------------------------------- /ifc/glfw/abstract-os-compat.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (defun get-required-instance-extensions () 4 | (with-foreign-object (p-extension-count :unsigned-int) 5 | (let ((pp-extensions (glfwGetRequiredInstanceExtensions p-extension-count))) 6 | (loop for i from 0 below (mem-aref p-extension-count :unsigned-int) 7 | collect (foreign-string-to-lisp (mem-aref pp-extensions :pointer i)))))) 8 | 9 | (defun os-window-should-close-p (window) 10 | (not (zerop (glfwWindowShouldClose (h window))))) 11 | 12 | (defun (setf os-window-should-close-p) (value window) 13 | (glfwSetWindowShouldClose (h window) (if value 1 0))) 14 | 15 | (defun (setf os-window-title) (title window) 16 | (glfwSetWindowTitle (h window) title)) 17 | 18 | (defun get-os-window-pos (window) 19 | (with-foreign-objects ((p-x :int) 20 | (p-y :int)) 21 | (glfwGetWindowPos (h window) p-x p-y) 22 | (values (mem-aref p-x :int) 23 | (mem-aref p-y :int)))) 24 | 25 | (defun set-os-window-pos (window x y) 26 | (glfwSetWindowPos (h window) (round x) (round y))) 27 | 28 | (defun get-os-window-cursor-pos (window) 29 | (with-foreign-objects ((p-x :double) 30 | (p-y :double)) 31 | (glfwGetCursorPos (h window) p-x p-y) 32 | (values (mem-aref p-x :double) 33 | (mem-aref p-y :double)))) 34 | 35 | (defun get-os-window-size (window) 36 | (with-foreign-objects ((p-width :int) 37 | (p-height :int)) 38 | (glfwGetWindowSize (h window) p-width p-height) 39 | (values (mem-aref p-width :int) 40 | (mem-aref p-height :int)))) 41 | 42 | (defun focus-os-window (window) 43 | (glfwFocusWindow (h window))) 44 | 45 | (defun hide-os-window (window) 46 | (glfwHideWindow (h window))) 47 | 48 | (defun show-os-window (window) 49 | (glfwShowWindow (h window))) 50 | 51 | (defun maximize-os-window (window) 52 | (glfwMaximizeWindow (h window))) 53 | 54 | (defun restore-os-window (window) 55 | (glfwRestoreWindow (h window))) 56 | 57 | (defun iconify-os-window (window) 58 | (glfwIconifyWindow (h window))) 59 | 60 | (defun get-os-window-frame-size (window) 61 | (with-foreign-objects ((p-left :int) 62 | (p-top :int) 63 | (p-right :int) 64 | (p-bottom :int)) 65 | (glfwGetWindowFrameSize (h window) p-left p-top p-right p-bottom) 66 | (values (mem-aref p-left :int) (mem-aref p-top :int) 67 | (mem-aref p-right :int) (mem-aref p-bottom :int)))) 68 | 69 | (defun get-os-window-framebuffer-size (window) 70 | (with-foreign-objects ((p-width :int) 71 | (p-height :int)) 72 | (glfwGetFramebufferSize (h window) p-width p-height) 73 | (values (mem-aref p-width :int) (mem-aref p-height :int)))) 74 | 75 | (defun set-os-window-size (window height width) 76 | (glfwSetWindowSize (h window) height width)) 77 | 78 | (defun set-os-window-aspect-ratio (window numer denom) 79 | (glfwSetWindowAspectRatio (h window) numer denom)) 80 | 81 | (defun set-os-window-size-limits (window min-width min-height max-width max-height) 82 | (glfwSetWindowSizeLimits (h window) min-width min-height max-width max-height)) 83 | 84 | (defun create-glfw-window-surface (instance window &key (allocator +null-allocator+)) 85 | (with-foreign-object (p-surface 'VkSurfaceKHR) 86 | (check-vk-result (glfwCreateWindowSurface (h instance) (h window) (h allocator) p-surface)) 87 | (let ((surface (make-instance 'surface 88 | :handle (mem-aref p-surface 'VkSurfaceKHR) 89 | :window window 90 | :instance instance 91 | :allocator allocator))) 92 | (setf (render-surface window) surface)))) 93 | -------------------------------------------------------------------------------- /ifc/glfw/package.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :cl-user) 23 | 24 | (defpackage :$glfw 25 | (:export #:GLFW_VERSION_MAJOR 26 | #:GLFW_VERSION_MINOR 27 | #:GLFW_VERSION_REVISION 28 | #:GLFW_TRUE 29 | #:GLFW_FALSE 30 | #:GLFW_RELEASE 31 | #:GLFW_PRESS 32 | #:GLFW_REPEAT 33 | #:GLFW_KEY_UNKNOWN 34 | #:GLFW_KEY_SPACE 35 | #:GLFW_KEY_APOSTROPHE 36 | #:GLFW_KEY_COMMA 37 | #:GLFW_KEY_MINUS 38 | #:GLFW_KEY_PERIOD 39 | #:GLFW_KEY_SLASH 40 | #:GLFW_KEY_0 41 | #:GLFW_KEY_1 42 | #:GLFW_KEY_2 43 | #:GLFW_KEY_3 44 | #:GLFW_KEY_4 45 | #:GLFW_KEY_5 46 | #:GLFW_KEY_6 47 | #:GLFW_KEY_7 48 | #:GLFW_KEY_8 49 | #:GLFW_KEY_9 50 | #:GLFW_KEY_SEMICOLON 51 | #:GLFW_KEY_EQUAL 52 | #:GLFW_KEY_A 53 | #:GLFW_KEY_B 54 | #:GLFW_KEY_C 55 | #:GLFW_KEY_D 56 | #:GLFW_KEY_E 57 | #:GLFW_KEY_F 58 | #:GLFW_KEY_G 59 | #:GLFW_KEY_H 60 | #:GLFW_KEY_I 61 | #:GLFW_KEY_J 62 | #:GLFW_KEY_K 63 | #:GLFW_KEY_L 64 | #:GLFW_KEY_M 65 | #:GLFW_KEY_N 66 | #:GLFW_KEY_O 67 | #:GLFW_KEY_P 68 | #:GLFW_KEY_Q 69 | #:GLFW_KEY_R 70 | #:GLFW_KEY_S 71 | #:GLFW_KEY_T 72 | #:GLFW_KEY_U 73 | #:GLFW_KEY_V 74 | #:GLFW_KEY_W 75 | #:GLFW_KEY_X 76 | #:GLFW_KEY_Y 77 | #:GLFW_KEY_Z 78 | #:GLFW_KEY_LEFT_BRACKET 79 | #:GLFW_KEY_BACKSLASH 80 | #:GLFW_KEY_RIGHT_BRACKET 81 | #:GLFW_KEY_GRAVE_ACCENT 82 | #:GLFW_KEY_WORLD_1 83 | #:GLFW_KEY_WORLD_2 84 | #:GLFW_KEY_ESCAPE 85 | #:GLFW_KEY_ENTER 86 | #:GLFW_KEY_TAB 87 | #:GLFW_KEY_BACKSPACE 88 | #:GLFW_KEY_INSERT 89 | #:GLFW_KEY_DELETE 90 | #:GLFW_KEY_RIGHT 91 | #:GLFW_KEY_LEFT 92 | #:GLFW_KEY_DOWN 93 | #:GLFW_KEY_UP 94 | #:GLFW_KEY_PAGE_UP 95 | #:GLFW_KEY_PAGE_DOWN 96 | #:GLFW_KEY_HOME 97 | #:GLFW_KEY_END 98 | #:GLFW_KEY_CAPS_LOCK 99 | #:GLFW_KEY_SCROLL_LOCK 100 | #:GLFW_KEY_NUM_LOCK 101 | #:GLFW_KEY_PRINT_SCREEN 102 | #:GLFW_KEY_PAUSE 103 | #:GLFW_KEY_F1 104 | #:GLFW_KEY_F2 105 | #:GLFW_KEY_F3 106 | #:GLFW_KEY_F4 107 | #:GLFW_KEY_F5 108 | #:GLFW_KEY_F6 109 | #:GLFW_KEY_F7 110 | #:GLFW_KEY_F8 111 | #:GLFW_KEY_F9 112 | #:GLFW_KEY_F10 113 | #:GLFW_KEY_F11 114 | #:GLFW_KEY_F12 115 | #:GLFW_KEY_F13 116 | #:GLFW_KEY_F14 117 | #:GLFW_KEY_F15 118 | #:GLFW_KEY_F16 119 | #:GLFW_KEY_F17 120 | #:GLFW_KEY_F18 121 | #:GLFW_KEY_F19 122 | #:GLFW_KEY_F20 123 | #:GLFW_KEY_F21 124 | #:GLFW_KEY_F22 125 | #:GLFW_KEY_F23 126 | #:GLFW_KEY_F24 127 | #:GLFW_KEY_F25 128 | #:GLFW_KEY_KP_0 129 | #:GLFW_KEY_KP_1 130 | #:GLFW_KEY_KP_2 131 | #:GLFW_KEY_KP_3 132 | #:GLFW_KEY_KP_4 133 | #:GLFW_KEY_KP_5 134 | #:GLFW_KEY_KP_6 135 | #:GLFW_KEY_KP_7 136 | #:GLFW_KEY_KP_8 137 | #:GLFW_KEY_KP_9 138 | #:GLFW_KEY_KP_DECIMAL 139 | #:GLFW_KEY_KP_DIVIDE 140 | #:GLFW_KEY_KP_MULTIPLY 141 | #:GLFW_KEY_KP_SUBTRACT 142 | #:GLFW_KEY_KP_ADD 143 | #:GLFW_KEY_KP_ENTER 144 | #:GLFW_KEY_KP_EQUAL 145 | #:GLFW_KEY_LEFT_SHIFT 146 | #:GLFW_KEY_LEFT_CONTROL 147 | #:GLFW_KEY_LEFT_ALT 148 | #:GLFW_KEY_LEFT_SUPER 149 | #:GLFW_KEY_RIGHT_SHIFT 150 | #:GLFW_KEY_RIGHT_CONTROL 151 | #:GLFW_KEY_RIGHT_ALT 152 | #:GLFW_KEY_RIGHT_SUPER 153 | #:GLFW_KEY_MENU 154 | #:GLFW_KEY_LAST 155 | #:GLFW_MOD_SHIFT 156 | #:GLFW_MOD_CONTROL 157 | #:GLFW_MOD_ALT 158 | #:GLFW_MOD_SUPER 159 | #:GLFW_MOUSE_BUTTON_1 160 | #:GLFW_MOUSE_BUTTON_2 161 | #:GLFW_MOUSE_BUTTON_3 162 | #:GLFW_MOUSE_BUTTON_4 163 | #:GLFW_MOUSE_BUTTON_5 164 | #:GLFW_MOUSE_BUTTON_6 165 | #:GLFW_MOUSE_BUTTON_7 166 | #:GLFW_MOUSE_BUTTON_8 167 | #:GLFW_MOUSE_BUTTON_LAST 168 | #:GLFW_MOUSE_BUTTON_LEFT 169 | #:GLFW_MOUSE_BUTTON_RIGHT 170 | #:GLFW_MOUSE_BUTTON_MIDDLE 171 | #:GLFW_JOYSTICK_1 172 | #:GLFW_JOYSTICK_2 173 | #:GLFW_JOYSTICK_3 174 | #:GLFW_JOYSTICK_4 175 | #:GLFW_JOYSTICK_5 176 | #:GLFW_JOYSTICK_6 177 | #:GLFW_JOYSTICK_7 178 | #:GLFW_JOYSTICK_8 179 | #:GLFW_JOYSTICK_9 180 | #:GLFW_JOYSTICK_10 181 | #:GLFW_JOYSTICK_11 182 | #:GLFW_JOYSTICK_12 183 | #:GLFW_JOYSTICK_13 184 | #:GLFW_JOYSTICK_14 185 | #:GLFW_JOYSTICK_15 186 | #:GLFW_JOYSTICK_16 187 | #:GLFW_JOYSTICK_LAST 188 | 189 | #:GLFW_NOT_INITIALIZED 190 | #:GLFW_NO_CURRENT_CONTEXT 191 | #:GLFW_INVALID_ENUM 192 | #:GLFW_INVALID_VALUE 193 | #:GLFW_OUT_OF_MEMORY 194 | #:GLFW_API_UNAVAILABLE 195 | #:GLFW_VERSION_UNAVAILABLE 196 | #:GLFW_PLATFORM_ERROR 197 | #:GLFW_FORMAT_UNAVAILABLE 198 | #:GLFW_NO_WINDOW_CONTEXT 199 | #:GLFW_FOCUSED 200 | #:GLFW_ICONIFIED 201 | #:GLFW_RESIZABLE 202 | #:GLFW_VISIBLE 203 | #:GLFW_DECORATED 204 | #:GLFW_AUTO_ICONIFY 205 | #:GLFW_FLOATING 206 | #:GLFW_MAXIMIZED 207 | #:GLFW_RED_BITS 208 | #:GLFW_GREEN_BITS 209 | #:GLFW_BLUE_BITS 210 | #:GLFW_ALPHA_BITS 211 | #:GLFW_DEPTH_BITS 212 | #:GLFW_STENCIL_BITS 213 | #:GLFW_ACCUM_RED_BITS 214 | #:GLFW_ACCUM_GREEN_BITS 215 | #:GLFW_ACCUM_BLUE_BITS 216 | #:GLFW_ACCUM_ALPHA_BITS 217 | #:GLFW_AUX_BUFFERS 218 | #:GLFW_STEREO 219 | #:GLFW_SAMPLES 220 | #:GLFW_SRGB_CAPABLE 221 | #:GLFW_REFRESH_RATE 222 | #:GLFW_DOUBLEBUFFER 223 | #:GLFW_CLIENT_API 224 | #:GLFW_CONTEXT_VERSION_MAJOR 225 | #:GLFW_CONTEXT_VERSION_MINOR 226 | #:GLFW_CONTEXT_REVISION 227 | #:GLFW_CONTEXT_ROBUSTNESS 228 | #:GLFW_OPENGL_FORWARD_COMPAT 229 | #:GLFW_OPENGL_DEBUG_CONTEXT 230 | #:GLFW_OPENGL_PROFILE 231 | #:GLFW_CONTEXT_RELEASE_BEHAVIOR 232 | #:GLFW_CONTEXT_NO_ERROR 233 | #:GLFW_CONTEXT_CREATION_API 234 | #:GLFW_NO_API 235 | #:GLFW_OPENGL_API 236 | #:GLFW_OPENGL_ES_API 237 | #:GLFW_NO_ROBUSTNESS 238 | #:GLFW_NO_RESET_NOTIFICATION 239 | #:GLFW_LOSE_CONTEXT_ON_RESET 240 | #:GLFW_OPENGL_ANY_PROFILE 241 | #:GLFW_OPENGL_CORE_PROFILE 242 | #:GLFW_OPENGL_COMPAT_PROFILE 243 | #:GLFW_CURSOR 244 | #:GLFW_STICKY_KEYS 245 | #:GLFW_STICKY_MOUSE_BUTTONS 246 | #:GLFW_CURSOR_NORMAL 247 | #:GLFW_CURSOR_HIDDEN 248 | #:GLFW_CURSOR_DISABLED 249 | #:GLFW_ANY_RELEASE_BEHAVIOR 250 | #:GLFW_RELEASE_BEHAVIOR_FLUSH 251 | #:GLFW_RELEASE_BEHAVIOR_NONE 252 | #:GLFW_NATIVE_CONTEXT_API 253 | #:GLFW_EGL_CONTEXT_API 254 | #:GLFW_ARROW_CURSOR 255 | #:GLFW_IBEAM_CURSOR 256 | #:GLFW_CROSSHAIR_CURSOR 257 | #:GLFW_HAND_CURSOR 258 | #:GLFW_HRESIZE_CURSOR 259 | #:GLFW_VRESIZE_CURSOR 260 | #:GLFW_CONNECTED 261 | #:GLFW_DISCONNECTED 262 | #:GLFW_DONT_CARE 263 | 264 | #:GLFWvidmode 265 | #:GLFWgammaramp 266 | #:GLFWimage 267 | 268 | #:glfwInit 269 | #:glfwTerminate 270 | #:glfwGetVersion 271 | #:glfwGetVersionString 272 | #:glfwSetErrorCallback 273 | #:glfwGetMonitors 274 | #:glfwGetPrimaryMonitor 275 | #:glfwGetMonitorPos 276 | #:glfwGetMonitorPhysicalSize 277 | #:glfwGetMonitorName 278 | #:glfwSetMonitorCallback 279 | #:glfwGetVideoModes 280 | #:glfwGetVideoMode 281 | #:glfwSetGamma 282 | #:glfwGetGammaRamp 283 | #:glfwSetGammaRamp 284 | #:glfwDefaultWindowHints 285 | #:glfwWindowHint 286 | #:glfwCreateWindow 287 | #:glfwDestroyWindow 288 | #:glfwWindowShouldClose 289 | #:glfwSetWindowShouldClose 290 | #:glfwSetWindowTitle 291 | #:glfwSetWindowIcon 292 | #:glfwGetWindowPos 293 | #:glfwSetWindowPos 294 | #:glfwGetWindowSize 295 | #:glfwSetWindowSizeLimits 296 | #:glfwSetWindowAspectRatio 297 | #:glfwSetWindowSize 298 | #:glfwGetFramebufferSize 299 | #:glfwGetWindowFrameSize 300 | #:glfwIconifyWindow 301 | #:glfwRestoreWindow 302 | #:glfwMaximizeWindow 303 | #:glfwShowWindow 304 | #:glfwHideWindow 305 | #:glfwFocusWindow 306 | #:glfwGetWindowMonitor 307 | #:glfwSetWindowMonitor 308 | #:glfwGetWindowAttrib 309 | #:glfwSetWindowUserPointer 310 | #:glfwGetWindowUserPointer 311 | #:glfwSetWindowPosCallback 312 | #:glfwSetWindowSizeCallback 313 | #:glfwSetWindowCloseCallback 314 | #:glfwSetWindowRefreshCallback 315 | #:glfwSetWindowFocusCallback 316 | #:glfwSetWindowIconifyCallback 317 | #:glfwSetFramebufferSizeCallback 318 | #:glfwPollEvents 319 | #:glfwWaitEvents 320 | #:glfwWaitEventsTimeout 321 | #:glfwPostEmptyEvent 322 | #:glfwGetInputMode 323 | #:glfwSetInputMode 324 | #:glfwGetKeyName 325 | #:glfwGetKey 326 | #:glfwGetMouseButton 327 | #:glfwGetCursorPos 328 | #:glfwSetCursorPos 329 | #:glfwCreateCursor 330 | #:glfwCreateStandardCursor 331 | #:glfwDestroyCursor 332 | #:glfwSetCursor 333 | #:glfwSetKeyCallback 334 | #:glfwSetCharCallback 335 | #:glfwSetCharModsCallback 336 | #:glfwSetMouseButtonCallback 337 | #:glfwSetCursorPosCallback 338 | #:glfwSetCursorEnterCallback 339 | #:glfwSetScrollCallback 340 | #:glfwSetDropCallback 341 | #:glfwJoystickPresent 342 | #:glfwGetJoystickAxes 343 | #:glfwGetJoystickButtons 344 | #:glfwGetJoystickName 345 | #:glfwSetJoystickCallback 346 | #:glfwSetClipboardString 347 | #:glfwGetClipboardString 348 | #:glfwGetTime 349 | #:glfwSetTime 350 | #:glfwGetTimerValue 351 | #:glfwGetTimerFrequency 352 | #:glfwMakeCurrentContext 353 | #:glfwGetCurrentContext 354 | #:glfwSwapBuffers 355 | #:glfwSwapInterval 356 | #:glfwExtensionSupported 357 | #:glfwGetProcAddress 358 | #:glfwVulkanSupported 359 | #:glfwGetRequiredInstanceExtensions)) 360 | -------------------------------------------------------------------------------- /ifc/load-foreign-libs.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :cl-user) 23 | 24 | (defparameter *home-dir* 25 | (namestring (user-homedir-pathname))) 26 | 27 | (defparameter *cl-vulkan-dir* 28 | (namestring (asdf/system:system-relative-pathname :cl-vulkan ""))) 29 | 30 | ;; install vulkansdk systemwide using sudo ./install_vulkan.py from the Vulkan SDK folder 31 | ;; and set vk::*debug* to t or positive integer before creating vulkan instance to get validation layers 32 | #+(and sbcl darwin nil) 33 | (let ((vulkan-sdk-path (concatenate 'string *home-dir* "/VulkanSDK/1.3.261.1/macOS"))) 34 | 35 | (sb-posix:setenv "VULKAN_SDK" vulkan-sdk-path 0) 36 | (sb-posix:setenv "DYLD_LIBRARY_PATH" (concatenate 'string (sb-posix:getenv "DYLD_LIBRARY_PATH") ":" vulkan-sdk-path "/lib") 0) 37 | (sb-posix:setenv "VK_ADD_LAYER_PATH" (concatenate 'string vulkan-sdk-path "/share/vulkan/explicit_layer.d") 0) 38 | (sb-posix:setenv "VK_ICD_FILENAMES" (concatenate 'string vulkan-sdk-path "/share/vulkan/icd.d/MoltenVK_icd.json") 0) 39 | (sb-posix:setenv "VK_DRIVER_FILES" (concatenate 'string vulkan-sdk-path "/share/vulkan/icd.d/MoltenVK_icd.json") 0) 40 | 41 | ;; (sb-posix:setenv "VULKAN_FRAMEWORK_PATH" (concatenate 'string vulkan-sdk-path "/Frameworks") 0) 42 | ;; (sb-posix:setenv "DYLD_FRAMEWORK_PATH" (concatenate 'string vulkan-sdk-path "/Frameworks") 0) 43 | ) 44 | 45 | #+(and ccl darwin nil) 46 | (let ((vulkan-sdk-path (concatenate 'string *home-dir* "/VulkanSDK/1.3.231.1/macOS"))) 47 | 48 | (setf (uiop/os:getenv "VULKAN_SDK") vulkan-sdk-path) 49 | (setf (uiop/os:getenv "DYLD_LIBRARY_PATH") (concatenate 'string (uiop/os:getenv "DYLD_LIBRARY_PATH") ":" vulkan-sdk-path "/lib")) 50 | (setf (uiop/os:getenv "VK_ADD_LAYER_PATH") (concatenate 'string vulkan-sdk-path "/share/vulkan/explicit_layer.d")) 51 | (setf (uiop/os:getenv "VK_ICD_FILENAMES") (concatenate 'string vulkan-sdk-path "/share/vulkan/icd.d/MoltenVK_icd.json")) 52 | (setf (uiop/os:getenv "VK_DRIVER_FILES") (concatenate 'string vulkan-sdk-path "/share/vulkan/icd.d/MoltenVK_icd.json")) 53 | ) 54 | 55 | #+swiftshader 56 | (sb-posix:setenv "VK_ICD_FILENAMES" 57 | (concatenate 'string *home-dir* "/swiftshader-build1/Linux/vk_swiftshader_icd.json") 0) 58 | 59 | #+(and linux sbcl) 60 | (let ((vulkan-sdk-path (concatenate 'string *home-dir* "vulkan/1.3.231.0/x86_64"))) 61 | (sb-posix:setenv "VULKAN_SDK" vulkan-sdk-path 0) 62 | (sb-posix:setenv "VK_ADD_LAYER_PATH" (concatenate 'string vulkan-sdk-path "/etc/vulkan/explicit_layer.d") 0) 63 | (sb-posix:setenv "VK_INSTANCE_LAYERS" "VK_LAYER_KHRONOS_validation" 0)) 64 | 65 | 66 | 67 | #+glfw 68 | (cffi:define-foreign-library glfw3 69 | (:darwin "libglfw.3.dylib") 70 | (:windows "glfw3.dll") 71 | (:linux "libglfw.so.3")) 72 | 73 | (cffi:define-foreign-library vulkan-loader 74 | (:linux "libvulkan.so.1") 75 | (:darwin "libvulkan.1.dylib") 76 | (:windows "vulkan-1.dll")) 77 | 78 | #+glfw 79 | (cffi:use-foreign-library glfw3) 80 | 81 | (cffi:use-foreign-library vulkan-loader) 82 | -------------------------------------------------------------------------------- /ifc/vulkan/vk-macros.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (cl:in-package #:%vk) 23 | 24 | (cl:defmacro defvkinstextfun ((cname lname) result-type cl:&body args) 25 | (cl:let ((instance-arg (cl:gensym "INSTANCE"))) 26 | `(cl:defun ,lname (,instance-arg ,@(cl:mapcar 'cl:car args)) 27 | (cffi:foreign-funcall-pointer 28 | (cffi:with-foreign-string (p-native ,cname) 29 | (VkGetInstanceProcAddr ,instance-arg p-native)) 30 | cl:nil 31 | ,@(cl:loop for arg in args 32 | collect (cl:second arg) collect (cl:first arg)) 33 | ,result-type)))) 34 | 35 | (cl:defmacro defvkdevextfun ((cname lname) result-type cl:&body args) 36 | (cl:let ((device-arg (cl:gensym "DEVICE"))) 37 | `(cl:defun ,lname (,device-arg ,@(cl:mapcar 'cl:car args)) 38 | (cffi:foreign-funcall-pointer 39 | (cffi:with-foreign-string (p-native ,cname) 40 | (VkGetDeviceProcAddr ,device-arg p-native)) 41 | cl:nil 42 | ,@(cl:loop for arg in args 43 | collect (cl:second arg) collect (cl:first arg)) 44 | ,result-type)))) 45 | 46 | (cl:defun zero-struct (p struct-typespec) 47 | (cl:loop for i from 0 below (cffi:foreign-type-size struct-typespec) 48 | do (cl:setf (cffi:mem-aref p :unsigned-char i) 0)) 49 | (cl:values)) 50 | 51 | (cl:defmacro with-vk-struct ((p-info struct-type) cl:&body body) 52 | `(cffi:with-foreign-object (,p-info '(:struct ,struct-type)) 53 | (zero-struct ,p-info '(:struct ,struct-type)) 54 | ,@(cl:when (cl:gethash struct-type *s-type-table*) 55 | `((cl:setf (cffi:foreign-slot-value ,p-info '(:struct ,struct-type) 'sType) 56 | ,(cl:gethash struct-type *s-type-table*)))) 57 | ,@body)) 58 | -------------------------------------------------------------------------------- /shaders/comp.spv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/awolven/cl-vulkan/13f9a13d1fe92cef2a049b7d9f13a107a96f0c4b/shaders/comp.spv -------------------------------------------------------------------------------- /shaders/frag.spv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/awolven/cl-vulkan/13f9a13d1fe92cef2a049b7d9f13a107a96f0c4b/shaders/frag.spv -------------------------------------------------------------------------------- /shaders/shader.comp: -------------------------------------------------------------------------------- 1 | #version 450 2 | #extension GL_ARB_separate_shader_objects : enable 3 | 4 | layout(set = 0, binding = 0) uniform UniformBufferObject { 5 | mat4 matrix; 6 | uint nverts; 7 | } ubo; 8 | 9 | layout(set = 0, binding = 1) buffer lay0 { float verts[]; } buf; 10 | 11 | void main() { 12 | const uint i = gl_GlobalInvocationID.x; 13 | if (i >= ubo.nverts) 14 | return; 15 | vec4 result = ubo.matrix * vec4(buf.verts[i*3+0], buf.verts[i*3+1], buf.verts[i*3+2], 1.0); 16 | buf.verts[i*3+0] = result.x/result.w; 17 | buf.verts[i*3+1] = result.y/result.w; 18 | buf.verts[i*3+2] = result.z/result.w; 19 | } 20 | -------------------------------------------------------------------------------- /shaders/shader.frag: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 2019 Andrew Kenneth Wolven 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining 5 | a copy of this software and associated documentation files (the 6 | "Software"), to deal in the Software without restriction, including 7 | without limitation the rights to use, copy, modify, merge, publish, 8 | distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so, subject to 10 | the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 19 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 20 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 21 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | */ 23 | #version 450 24 | #extension GL_ARB_separate_shader_objects : enable 25 | layout(location = 0) in vec3 fragColor; 26 | layout(location = 1) in vec4 viewPosition; 27 | 28 | layout(location = 0) out vec4 outColor; 29 | void main() { 30 | vec3 xTangent = dFdx(viewPosition.xyz/viewPosition.w); 31 | vec3 yTangent = dFdy(viewPosition.xyz/viewPosition.w); 32 | vec3 faceNormal = normalize(cross(xTangent, yTangent)); 33 | vec3 lDirection = normalize(vec3(1.0, 1.0, 1.0)); 34 | vec4 ambient = vec4(fragColor, 1.0); 35 | vec4 diffuse = vec4(max(dot(lDirection, -faceNormal), 0) * fragColor, 1.0); 36 | 37 | outColor = ambient * 0.35 + diffuse; 38 | 39 | // vec3 normal = normalize(inNormal); 40 | // float diffuse = max(0.0, dot(-normal, normalize(vec3(-1.0, -1.0, -1.0)))); 41 | //outColor = vec4(fragColor + (fragColor * diffuse), 1.0); 42 | //outColor=vec4(fragColor, 1.0); 43 | } 44 | -------------------------------------------------------------------------------- /shaders/shader.vert: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 2019 Andrew Kenneth Wolven 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining 5 | a copy of this software and associated documentation files (the 6 | "Software"), to deal in the Software without restriction, including 7 | without limitation the rights to use, copy, modify, merge, publish, 8 | distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so, subject to 10 | the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 19 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 20 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 21 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | */ 23 | #version 450 24 | #extension GL_ARB_separate_shader_objects : enable 25 | 26 | layout(binding = 0) uniform UniformBufferObject { 27 | mat4 model; 28 | mat4 view; 29 | mat4 proj; 30 | mat4 clip; 31 | } ubo; 32 | 33 | layout(location = 0) in vec3 inPosition; 34 | layout(location = 1) in vec3 inColor; 35 | 36 | layout(location = 0) out vec3 fragColor; 37 | layout(location = 1) out vec4 viewPosition; 38 | 39 | out gl_PerVertex { 40 | vec4 gl_Position; 41 | }; 42 | 43 | void main() { 44 | 45 | viewPosition = ubo.view * ubo.model * vec4(inPosition, 1.0); 46 | gl_Position = ubo.clip * ubo.proj * viewPosition; 47 | 48 | fragColor = inColor; 49 | } 50 | -------------------------------------------------------------------------------- /shaders/vert.spv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/awolven/cl-vulkan/13f9a13d1fe92cef2a049b7d9f13a107a96f0c4b/shaders/vert.spv -------------------------------------------------------------------------------- /src/allocation-callbacks.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | 25 | -------------------------------------------------------------------------------- /src/buffers.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defcstruct %vk::VkBufferOpaqueCaptureAddressCreateInfo 25 | (%vk::sType VKStructureType) 26 | (%vk::pNext :pointer) 27 | (%vk::opaqueCaptureAddress :uint64)) 28 | 29 | (defun create-buffer-1 (device size usage &key (allocator +null-allocator+) 30 | (buffer-class 'buffer)) 31 | (with-vk-struct (p-info VkBufferCreateInfo) 32 | (with-foreign-slots ((%vk::size 33 | %vk::usage 34 | %vk::sharingMode) 35 | p-info (:struct VkBufferCreateInfo)) 36 | (setf %vk::size size 37 | %vk::usage usage 38 | %vk::sharingMode VK_SHARING_MODE_EXCLUSIVE) 39 | (with-foreign-object (p-buffer 'VkBuffer) 40 | (check-vk-result (vkCreateBuffer (h device) p-info (h allocator) p-buffer)) 41 | (make-instance buffer-class :handle (mem-aref p-buffer 'VkBuffer) 42 | :size size :device device :allocator allocator))))) 43 | 44 | (defun destroy-buffer (buffer) 45 | (with-slots (device) buffer 46 | (vkDestroyBuffer (h device) (h buffer) (h (allocator buffer))) 47 | (vkFreeMemory (h device) (h (allocated-memory buffer)) (h (allocator (allocated-memory buffer))))) 48 | (values)) 49 | 50 | (defctype VkMemoryAllocateFlags VkFlags) 51 | 52 | (defcstruct %vk::VkMemoryAllocateFlagsInfo 53 | (%vk::sType VkStructureType) 54 | (%vk::pNext :pointer) 55 | (%vk::flags VkMemoryAllocateFlags) 56 | (%vk::deviceMask :uint32)) 57 | 58 | (defconstant %vk::VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_FLAGS_INFO 1000060000) 59 | (defconstant %vk::VK_MEMORY_ALLOCATE_DEVICE_ADDRESS_BIT #x00000002) 60 | 61 | (defun allocate-buffer-memory (device buffer properties &key (allocator +null-allocator+)) 62 | (with-vk-struct (p-requirements VkMemoryRequirements) 63 | (vkGetBufferMemoryRequirements (h device) (h buffer) p-requirements) 64 | 65 | (with-foreign-object (p-alloc-flags-info '(:struct %vk::VkMemoryAllocateFlagsInfo)) 66 | (with-foreign-slots ((%vk::sType 67 | %vk::pNext 68 | %vk::flags 69 | %vk::deviceMask) 70 | p-alloc-flags-info 71 | (:struct %vk::VkMemoryAllocateFlagsInfo)) 72 | (setf %vk::sType %vk::VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_FLAGS_INFO 73 | %vk::pNext (null-pointer) 74 | %vk::flags %vk::VK_MEMORY_ALLOCATE_DEVICE_ADDRESS_BIT 75 | %vk::deviceMask 0)) 76 | (with-vk-struct (p-alloc-info VkMemoryAllocateInfo) 77 | (with-foreign-slots ((%vk::allocationSize 78 | %vk::memoryTypeIndex 79 | %vk::pNext) 80 | p-alloc-info 81 | (:struct VkMemoryAllocateInfo)) 82 | (setf %vk::allocationSize 83 | (foreign-slot-value p-requirements '(:struct VkMemoryRequirements) '%vk::size) 84 | %vk::memoryTypeIndex 85 | (find-memory-type 86 | (physical-device device) 87 | (foreign-slot-value p-requirements '(:struct VkMemoryRequirements) '%vk::memoryTypeBits) 88 | properties) 89 | %vk::pNext p-alloc-flags-info) 90 | (with-foreign-object (p-buffer-memory 'VkDeviceMemory) 91 | (check-vk-result (vkAllocateMemory (h device) p-alloc-info (h allocator) p-buffer-memory)) 92 | (make-instance 'allocated-memory :handle (mem-aref p-buffer-memory 'VkDeviceMemory) 93 | :device device 94 | :allocator allocator 95 | :alignment (foreign-slot-value p-requirements 96 | '(:struct VkMemoryRequirements) 97 | '%vk::alignment)))))))) 98 | 99 | (defun bind-buffer-memory (device buffer buffer-memory &optional (offset 0)) 100 | (vkBindBufferMemory (h device) (h buffer) (h buffer-memory) offset)) 101 | 102 | (defun bind-buffer-memory-resource (device buffer memory-resource &optional (offset 0)) 103 | (vkBindBufferMemory (h device) (h buffer) 104 | (h (vk::allocation 105 | (vk::memory-resource-memory-pool memory-resource))) 106 | offset)) 107 | 108 | (defun copy-buffer (device command-pool queue src-buffer dst-buffer size) 109 | (with-vk-struct (p-alloc-info VkCommandBufferAllocateInfo) 110 | (with-foreign-slots ((%vk::level 111 | %vk::commandPool 112 | %vk::commandBufferCount) 113 | p-alloc-info (:struct VkCommandBufferAllocateInfo)) 114 | (setf %vk::level VK_COMMAND_BUFFER_LEVEL_PRIMARY 115 | %vk::commandPool (h command-pool) 116 | %vk::commandBufferCount 1) 117 | 118 | (with-foreign-object (p-command-buffer 'VkCommandBuffer) 119 | (vkAllocateCommandBuffers (h device) p-alloc-info p-command-buffer) 120 | (let ((command-buffer (make-instance 'command-buffer :handle (mem-aref p-command-buffer 'VkCommandBuffer) 121 | :device device :command-pool command-pool))) 122 | (with-vk-struct (p-begin-info VkCommandBufferBeginInfo) 123 | (with-foreign-slots ((%vk::flags) 124 | p-begin-info (:struct VkCommandBufferBeginInfo)) 125 | (setf %vk::flags VK_COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT) 126 | (vkBeginCommandBuffer (h command-buffer) p-begin-info) 127 | (with-vk-struct (p-copy-region VkBufferCopy) 128 | (with-foreign-slots ((%vk::srcOffset 129 | %vk::dstOffset 130 | %vk::size) 131 | p-copy-region (:struct VkBufferCopy)) 132 | (setf %vk::srcOffset 0 133 | %vk::dstOffset 0 134 | %vk::size size) 135 | (vkCmdCopyBuffer (h command-buffer) (h src-buffer) (h dst-buffer) 1 p-copy-region) 136 | (vkEndCommandBuffer (h command-buffer)) 137 | (queue-submit1 queue command-buffer) 138 | (vkQueueWaitIdle (h queue)) 139 | (vkFreeCommandBuffers (h device) (h command-pool) 1 p-command-buffer))))))))) 140 | (values)) 141 | 142 | (defun create-empty-buffer (device size usage &key (allocator +null-allocator+) 143 | (memory-properties (logior VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT 144 | VK_MEMORY_PROPERTY_HOST_COHERENT_BIT)) 145 | (buffer-class 'buffer)) 146 | (let* ((buffer (create-buffer-1 device size usage :buffer-class buffer-class :allocator allocator)) 147 | (buffer-memory (allocate-buffer-memory device buffer memory-properties 148 | :allocator allocator))) 149 | (bind-buffer-memory device buffer buffer-memory) 150 | (setf (allocated-memory buffer) buffer-memory) 151 | buffer)) 152 | 153 | (defun create-buffer (device data size usage &key (allocator +null-allocator+) 154 | (memory-properties VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT) 155 | (buffer-class 'buffer)) 156 | (let* ((staging-buffer (create-buffer-1 device size VK_BUFFER_USAGE_TRANSFER_SRC_BIT :allocator allocator)) 157 | (staging-buffer-memory (allocate-buffer-memory device staging-buffer 158 | (logior VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT 159 | VK_MEMORY_PROPERTY_HOST_COHERENT_BIT) 160 | :allocator allocator))) 161 | (bind-buffer-memory device staging-buffer staging-buffer-memory) 162 | (with-foreign-object (pp-data :pointer) 163 | (vkMapMemory (h device) (h staging-buffer-memory) 0 size 0 pp-data) 164 | (memcpy (mem-aref pp-data :pointer) data size) 165 | (vkUnmapMemory (h device) (h staging-buffer-memory))) 166 | 167 | (let* ((buffer (create-buffer-1 device size (logior VK_BUFFER_USAGE_TRANSFER_DST_BIT usage) 168 | :buffer-class buffer-class :allocator allocator)) 169 | (buffer-memory (allocate-buffer-memory device buffer memory-properties 170 | :allocator allocator)) 171 | (queue-family-index (get-any-queue-family-index-with-transfer-support (physical-device device))) 172 | (queue (find-queue device queue-family-index)) 173 | (command-pool (find-command-pool device queue-family-index))) 174 | (bind-buffer-memory device buffer buffer-memory) 175 | (copy-buffer device command-pool queue staging-buffer buffer size) 176 | (vkDestroyBuffer (h device) (h staging-buffer) (h allocator)) 177 | (vkFreeMemory (h device) (h staging-buffer-memory) (h allocator)) 178 | (setf (allocated-memory buffer) buffer-memory) 179 | buffer))) 180 | 181 | (defun create-vertex-buffer (device data size &key (allocator +null-allocator+)) 182 | (create-buffer device data size VK_BUFFER_USAGE_VERTEX_BUFFER_BIT 183 | :buffer-class 'vertex-buffer :allocator allocator)) 184 | 185 | (defun create-index-buffer (device data size &key (allocator +null-allocator+)) 186 | (create-buffer device data size VK_BUFFER_USAGE_INDEX_BUFFER_BIT 187 | :buffer-class 'index-buffer :allocator allocator)) 188 | 189 | (defun create-uniform-buffer (device size &key (allocator +null-allocator+)) 190 | (let* ((buffer (create-buffer-1 device size VK_BUFFER_USAGE_UNIFORM_BUFFER_BIT 191 | :buffer-class 'uniform-buffer :allocator allocator)) 192 | (memory (allocate-buffer-memory device buffer (logior VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT 193 | VK_MEMORY_PROPERTY_HOST_COHERENT_BIT) 194 | :allocator allocator))) 195 | (bind-buffer-memory device buffer memory) 196 | (setf (allocated-memory buffer) memory) 197 | buffer)) 198 | 199 | (defun create-storage-buffer (device size &key (allocator +null-allocator+)) 200 | (let* ((buffer (create-buffer-1 device size VK_BUFFER_USAGE_STORAGE_BUFFER_BIT 201 | :buffer-class 'storage-buffer :allocator allocator)) 202 | (memory (allocate-buffer-memory device buffer (logior VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT 203 | VK_MEMORY_PROPERTY_HOST_COHERENT_BIT) 204 | :allocator allocator))) 205 | (bind-buffer-memory device buffer memory) 206 | (setf (allocated-memory buffer) memory) 207 | buffer)) 208 | 209 | (defun copy-uniform-buffer-memory (device data uniform-buffer-memory size) 210 | (with-foreign-object (pp-data :pointer) 211 | (vkMapMemory (h device) (h uniform-buffer-memory) 0 size 0 pp-data) 212 | (memcpy (mem-aref pp-data :pointer) data size) 213 | (vkUnmapMemory (h device) (h uniform-buffer-memory)))) 214 | 215 | (defun mmap-buffer (buffer array size) 216 | (let ((memory (allocated-memory buffer)) 217 | (device (device buffer))) 218 | (with-foreign-object (pp-dst :pointer) 219 | 220 | (check-vk-result (vkMapMemory (h device) (h memory) 0 size 0 pp-dst)) 221 | 222 | (let ((p-dst (mem-aref pp-dst :pointer))) 223 | (memcpy p-dst array size) 224 | 225 | (with-foreign-object (p-range '(:struct VkMappedMemoryRange)) 226 | (zero-struct p-range '(:struct VkMappedMemoryRange)) 227 | 228 | (with-foreign-slots ((%vk::sType 229 | %vk::memory 230 | %vk::size) 231 | p-range (:struct VkMappedMemoryRange)) 232 | 233 | (setf %vk::sType VK_STRUCTURE_TYPE_MAPPED_MEMORY_RANGE 234 | %vk::memory (h memory) 235 | %vk::size VK_WHOLE_SIZE)) 236 | 237 | (check-vk-result (vkFlushMappedMemoryRanges (h device) 1 p-range)) 238 | 239 | (vkUnmapMemory (h device) (h memory)) 240 | 241 | (values)))))) 242 | -------------------------------------------------------------------------------- /src/cocoa.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (defun get-cocoa-required-instance-extensions () 4 | (list "VK_KHR_surface" 5 | (if (symbol-value (intern (symbol-name '*use-metal-surface*) :vk)) 6 | "VK_EXT_metal_surface" 7 | "VK_MVK_macos_surface"))) 8 | 9 | #+objc 10 | (named-readtables:in-readtable :objc-readtable) 11 | 12 | #| 13 | typedef struct VkMetalSurfaceCreateInfoEXT { 14 | VkStructureType sType; 15 | const void* pNext; 16 | VkMetalSurfaceCreateFlagsEXT flags; 17 | const CAMetalLayer* pLayer; 18 | } VkMetalSurfaceCreateInfoEXT; 19 | |# 20 | 21 | (cffi:defcstruct %vk::VkMetalSurfaceCreateInfoEXT 22 | (%vk::sType :int) 23 | (%vk::pNext :pointer) 24 | (%vk::flags :int) 25 | (%vk::pLayer :pointer)) 26 | 27 | (defconstant %vk::VK_STRUCTURE_TYPE_METAL_SURFACE_CREATE_INFO_EXT 1000217000) 28 | #| 29 | typedef struct VkMacOSSurfaceCreateInfoMVK { 30 | VkStructureType sType; 31 | const void* pNext; 32 | VkMacOSSurfaceCreateFlagsMVK flags; 33 | const void* pView; 34 | } VkMacOSSurfaceCreateInfoMVK; 35 | |# 36 | 37 | (cffi:defcstruct %vk::VkMacOSSurfaceCreateInfoMVK 38 | (%vk::sType :int) 39 | (%vk::pNext :pointer) 40 | (%vk::flags :int) 41 | (%vk::pView :pointer)) 42 | 43 | (defconstant %vk::VK_STRUCTURE_TYPE_MACOS_SURFACE_CREATE_INFO_MVK 1000123000) 44 | 45 | (defvar *use-metal-surface* nil) 46 | 47 | #-glfw 48 | (defun create-cocoa-window-surface (window allocator) 49 | (let ((instance (get-vulkan-instance nil))) 50 | (with-foreign-object (p-surface 'VkSurfaceKHR) 51 | (let ((bundle (ns::|bundleWithPath:| #@NSBundle 52 | (objc-runtime::make-nsstring "/System/Library/Frameworks/QuartzCore.framework")))) 53 | (when (cffi:null-pointer-p bundle) 54 | (error "Cocoa: Failed to find QuartzCore.framework")) 55 | 56 | (setf (clui::window-layer window) 57 | (ns::|layer| (ns::|classNamed:| bundle (objc-runtime::make-nsstring "CAMetalLayer")))) 58 | 59 | (when (cffi:null-pointer-p (clui::window-layer window)) 60 | (error "Cocoa: Failed to create layer for view.")) 61 | ;;(when (abstract-os::window-retina? window) 62 | 63 | (ns::|setContentsScale:| (clui::window-layer window) (ns::|backingScaleFactor| window)) 64 | 65 | (ns::|setLayer:| (clui::window-content-view window) (clui::window-layer window)) 66 | (ns::|setWantsLayer:| (clui::window-content-view window) t) 67 | 68 | (let ((err)) 69 | (if *use-metal-surface* 70 | (let ((p-fn-vkCreateMetalSurfaceEXT 71 | (with-foreign-string (pstr "vkCreateMetalSurfaceEXT") 72 | (%vk:vkGetInstanceProcAddr (h instance) pstr)))) 73 | 74 | (when (cffi:null-pointer-p p-fn-vkCreateMetalSurfaceEXT) 75 | (warn "Cocoa: Vulkan instance missing VK_EXT_metal_surface extension")) 76 | 77 | (with-foreign-object (sci '(:struct %vk::VkMetalSurfaceCreateInfoEXT)) 78 | (%vk:zero-struct sci '(:struct %vk::VkMetalSurfaceCreateInfoEXT)) 79 | (with-foreign-slots ((%vk::sType 80 | %vk::pLayer) 81 | sci (:struct %vk::VkMetalSurfaceCreateInfoEXT)) 82 | (setf %vk::sType %vk::VK_STRUCTURE_TYPE_METAL_SURFACE_CREATE_INFO_EXT 83 | %vk::pLayer (clui::window-layer window)) 84 | (setq err (cffi:foreign-funcall-pointer p-fn-vkCreateMetalSurfaceEXT () 85 | :pointer (h instance) 86 | :pointer sci 87 | :pointer (h allocator) 88 | :pointer p-surface 89 | :int))))) 90 | (let ((p-fn-vkCreateMacOSSurfaceMVK 91 | (with-foreign-string (pstr "vkCreateMacOSSurfaceMVK") 92 | (%vk:vkGetInstanceProcAddr (h instance) pstr)))) 93 | 94 | (when (cffi:null-pointer-p p-fn-vkCreateMacOSSurfaceMVK) 95 | (error "Cocoa: Vulkan instance missing VK_MVK_macos_surface extension")) 96 | 97 | (with-foreign-object (sci '(:struct %vk::VkMacOSSurfaceCreateInfoMVK)) 98 | (%vk:zero-struct sci '(:struct %vk::VkMacOSSurfaceCreateInfoMVK)) 99 | (with-foreign-slots ((%vk::sType 100 | %VK::pView) 101 | sci (:struct %vk::VkMacOSSurfaceCreateInfoMVK)) 102 | (setf %vk::sType %vk::VK_STRUCTURE_TYPE_MACOS_SURFACE_CREATE_INFO_MVK 103 | %vk::pView (clui::objc-object-id (clui::window-content-view window))) 104 | (setq err (cffi:foreign-funcall-pointer p-fn-vkCreateMacOSSurfaceMVK () 105 | :pointer (h instance) 106 | :pointer sci 107 | :pointer (h allocator) 108 | :pointer p-surface 109 | :int)))))) 110 | (vk:check-vk-result err) 111 | 112 | (make-instance 'surface 113 | :handle (mem-aref p-surface 'VkSurfaceKHR) 114 | :window window 115 | :allocator allocator)))))) 116 | -------------------------------------------------------------------------------- /src/command-buffers.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-command-buffer (device command-pool &key (allocator +null-allocator+)) 25 | (let ((command-buffer (create-command-buffer-1 device command-pool :allocator allocator)) 26 | (command-buffers (command-buffers command-pool))) 27 | ;; store command buffers outside of frame-resources as well for non-frame-related command-buffer use 28 | (vector-push-extend command-buffer command-buffers) 29 | command-buffer)) 30 | 31 | (defun create-command-buffer-1 (device command-pool &key (allocator +null-allocator+)) 32 | (with-vk-struct (p-info VkCommandBufferAllocateInfo) 33 | (with-foreign-slots ((%vk::commandPool 34 | %vk::level 35 | %vk::commandBufferCount) 36 | p-info 37 | (:struct VkCommandBufferAllocateInfo)) 38 | (setf %vk::commandPool (h command-pool) 39 | %vk::level VK_COMMAND_BUFFER_LEVEL_PRIMARY 40 | %vk::commandBufferCount 1) 41 | (with-foreign-object (p-command-buffer 'VkCommandBuffer) 42 | (check-vk-result (vkAllocateCommandBuffers (h device) p-info p-command-buffer)) 43 | (make-instance 'command-buffer 44 | :handle (mem-aref p-command-buffer 'VkCommandBuffer) 45 | :device device :command-pool command-pool 46 | :allocator allocator))))) 47 | 48 | (defun free-command-buffers (command-pool) 49 | (let* ((command-buffers (command-buffers command-pool)) 50 | (count (length command-buffers))) 51 | (with-slots (device) command-pool 52 | (with-foreign-object (p-command-buffers 'VkCommandBuffer count) 53 | (loop for command-buffer across command-buffers for i from 0 54 | do (setf (mem-aref p-command-buffers 'VkCommandBuffer i) (h command-buffer))) 55 | (vkFreeCommandBuffers (h device) (h command-pool) count p-command-buffers) 56 | (setf (fill-pointer command-buffers) 0))))) 57 | 58 | (defun free-command-buffer (command-buffer) 59 | (let ((command-pool (command-pool command-buffer))) 60 | (with-foreign-object (p-command-buffer 'VkCommandBuffer) 61 | (setf (mem-aref p-command-buffer 'VkCommandBuffer) (h command-buffer)) 62 | (vkFreeCommandBuffers (h (device command-pool)) (h command-pool) 1 p-command-buffer))) 63 | (values)) 64 | 65 | (defun begin-command-buffer (command-buffer) 66 | (with-vk-struct (p-begin-info VkCommandBufferBeginInfo) 67 | (with-foreign-slots ((%vk::flags) 68 | p-begin-info (:struct VkCommandBufferBeginInfo)) 69 | (setf %vk::flags (logior %vk::flags VK_COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT)) 70 | 71 | (check-vk-result 72 | (vkBeginCommandBuffer (h command-buffer) p-begin-info))))) 73 | 74 | (defun end-command-buffer (command-buffer) 75 | (check-vk-result (vkEndCommandBuffer (h command-buffer)))) 76 | 77 | (defun cmd-set-viewport (command-buffer &key (x 0.0f0) (y 0.0f0) width height (min-depth 0.0f0) (max-depth 1.0f0)) 78 | (with-viewport (p-viewport :x x :y y :width width :height height :min-depth min-depth :max-depth max-depth) 79 | (vkCmdSetViewport (h command-buffer) 0 1 p-viewport))) 80 | 81 | (defun cmd-set-scissor (command-buffer &key (x 0) (y 0) width height) 82 | (with-scissor (p-scissor :x x :y y :width width :height height) 83 | (vkCmdSetScissor (h command-buffer) 0 1 p-scissor))) 84 | 85 | (defun cmd-bind-pipeline (command-buffer pipeline &key (bind-point :graphics)) 86 | (vkCmdBindPipeline (h command-buffer) 87 | (ecase bind-point 88 | (:graphics VK_PIPELINE_BIND_POINT_GRAPHICS) 89 | (:compute VK_PIPELINE_BIND_POINT_COMPUTE)) 90 | (h pipeline))) 91 | 92 | (defun cmd-bind-vertex-buffers (command-buffer vertex-buffers &optional (buffer-offsets (list 0)) 93 | (first-binding 0) 94 | (binding-count 1)) 95 | (let ((number-buffers (length vertex-buffers)) 96 | (number-offsets (length buffer-offsets))) 97 | (assert (or (eq number-buffers number-offsets) (eq number-offsets 1))) 98 | (when (and (> number-buffers 1) (eq number-offsets 1)) 99 | (setq buffer-offsets (make-list number-buffers :initial-element (first buffer-offsets)))) 100 | (with-foreign-objects ((p-vertex-buffers 'VkBuffer number-buffers) 101 | (p-offsets 'VkDeviceSize number-buffers)) 102 | (loop for i from 0 below number-buffers for buffer in vertex-buffers for offset in buffer-offsets 103 | do (setf (mem-aref p-vertex-buffers 'VkBuffer i) (h buffer) 104 | (mem-aref p-offsets 'VkDeviceSize) offset)) 105 | (vkCmdBindVertexBuffers (h command-buffer) first-binding binding-count p-vertex-buffers p-offsets)))) 106 | 107 | (defun cmd-bind-descriptor-sets (command-buffer pipeline-layout descriptor-sets &optional (bind-point :graphics)) 108 | (let ((count (length descriptor-sets))) 109 | (with-foreign-object (p-descriptor-sets 'VkDescriptorSet count) 110 | (loop for ds in descriptor-sets 111 | do 112 | (setf (mem-aref p-descriptor-sets 'VkDescriptorSet) (h ds))) 113 | (vkCmdBindDescriptorSets (h command-buffer) 114 | (ecase bind-point 115 | (:graphics VK_PIPELINE_BIND_POINT_GRAPHICS) 116 | (:compute VK_PIPELINE_BIND_POINT_COMPUTE)) 117 | (h pipeline-layout) 118 | 0 count p-descriptor-sets 0 +nullptr+)))) 119 | 120 | (defun cmd-bind-index-buffer (command-buffer index-buffer &optional (offset 0) (integer-type :unsigned-short)) 121 | (vkCmdBindIndexBuffer (h command-buffer) (h index-buffer) offset (ecase integer-type 122 | (:unsigned-short VK_INDEX_TYPE_UINT16) 123 | (:unsigned-int VK_INDEX_TYPE_UINT32) 124 | (:unsigned-int32 VK_INDEX_TYPE_UINT32)))) 125 | 126 | (defun cmd-draw-indexed (command-buffer command) 127 | (vkCmdDrawIndexed (h command-buffer) 128 | (draw-indexed-cmd-index-count command) 129 | 1 130 | (draw-indexed-cmd-first-index command) 131 | (draw-indexed-cmd-vertex-offset command) 132 | 0)) 133 | -------------------------------------------------------------------------------- /src/command-pool.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-command-pool (device queue-family-index &key (allocator +null-allocator+)) 25 | (with-vk-struct (p-info VkCommandPoolCreateInfo) 26 | (with-foreign-slots ((%vk::flags %vk::queueFamilyIndex) 27 | p-info (:struct VkCommandPoolCreateInfo)) 28 | (setf %vk::flags VK_COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT 29 | %vk::queueFamilyIndex queue-family-index) 30 | (with-foreign-object (p-command-pool 'VkCommandPool) 31 | (check-vk-result (vkCreateCommandPool (h device) p-info (h allocator) p-command-pool)) 32 | (let ((command-pool 33 | (make-instance 'command-pool :handle (mem-aref p-command-pool 'VkCommandPool) 34 | :device device 35 | :allocator allocator 36 | :index queue-family-index))) 37 | (push (list queue-family-index command-pool) (command-pools device)) 38 | command-pool))))) 39 | 40 | (defun find-command-pool (device queue-family-index) 41 | (let ((entry (assoc queue-family-index (command-pools device)))) 42 | (if entry 43 | (second entry) nil))) 44 | 45 | (defun destroy-command-pool (command-pool) 46 | (with-slots (device allocator) command-pool 47 | (vkDestroyCommandPool (h device) (h command-pool) (h allocator)) 48 | (setf (command-pools device) (remove-if #'(lambda (item) 49 | (pointer-eq (h (cadr item)) (h command-pool))) 50 | (command-pools device)))) 51 | (values)) 52 | 53 | (defun reset-command-pool (device command-pool) 54 | (check-vk-result 55 | (vkResetCommandPool (h device) (h command-pool) 0))) 56 | -------------------------------------------------------------------------------- /src/compute-pipeline.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-compute-pipeline (device pipeline-layout shader-module 25 | &key 26 | (pipeline-cache +null-pipeline-cache+) 27 | (create-infos 28 | (list (make-instance 'compute-pipeline-create-info 29 | :stage (make-instance 'shader-stage-create-info 30 | :module shader-module) 31 | :layout pipeline-layout))) 32 | (allocator +null-allocator+)) 33 | 34 | (let ((create-info-count (length create-infos))) 35 | (with-foreign-object (p-create-infos '(:struct VkComputePipelineCreateInfo) create-info-count) 36 | (loop for ci in create-infos for i from 0 37 | do (let ((p-create-info (mem-aptr p-create-infos '(:struct VkComputePipelineCreateInfo) i))) 38 | (zero-struct p-create-info '(:struct VkComputePipelineCreateInfo)) 39 | (with-vk-struct (p-ssci VkPipelineShaderStageCreateInfo) 40 | (let ((stage (slot-value ci 'stage))) 41 | (fill-pipeline-shader-stage-create-info 42 | p-ssci 43 | :stage (slot-value stage 'stage) 44 | :module (slot-value stage 'module) 45 | :p-name (foreign-string-alloc (slot-value stage 'name)))) ;;memory leak 46 | 47 | (with-foreign-slots ((%vk::sType 48 | %vk::pNext 49 | %vk::flags 50 | %vk::stage 51 | %vk::layout 52 | %vk::basePipelineHandle 53 | %vk::basePipelineIndex) 54 | p-create-info (:struct VkComputePipelineCreateInfo)) 55 | 56 | (setf %vk::sType VK_STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO 57 | %vk::pNext +nullptr+ 58 | %vk::flags (slot-value ci 'flags) 59 | %vk::stage p-ssci 60 | %vk::layout (h (slot-value ci 'layout)) 61 | %vk::basePipelineHandle (if (null-pointer-p (slot-value ci 'base-pipeline)) 62 | (slot-value ci 'base-pipeline) 63 | (h (slot-value ci 'base-pipeline))) 64 | %vk::basePipelineIndex (slot-value ci 'base-pipeline-index)))))) 65 | 66 | (with-foreign-object (p-pipelines 'VkPipeline 1) 67 | (check-vk-result 68 | (vkCreateComputePipelines (h device) (h pipeline-cache) 69 | create-info-count p-create-infos 70 | (h allocator) p-pipelines)) 71 | (make-instance 'compute-pipeline :handle (mem-aref p-pipelines 'VkPipeline) 72 | :device device 73 | :allocator allocator))))) 74 | -------------------------------------------------------------------------------- /src/debug-report.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defcallback debug-report-callback VkBool32 ((flags VkDebugReportFlagsEXT) (object-type VkDebugReportObjectTypeEXT) 25 | (object :uint64) (location size-t) (message-code :int32) 26 | (p-layer-prefix (:pointer :char)) (p-message (:pointer :char)) 27 | (p-user-data :pointer)) 28 | (debug-report-function flags object-type object location message-code p-layer-prefix p-message p-user-data)) 29 | 30 | (defun debug-report-function (flags object-type object location message-code p-layer-prefix p-message p-user-data) 31 | (declare (ignore flags object location message-code p-layer-prefix p-user-data)) 32 | (format *error-output* "[vulkan] ObjectType: ~A~%Message: ~A~%~%" object-type 33 | (foreign-string-to-lisp p-message)) 34 | (finish-output *error-output*) 35 | VK_FALSE) 36 | 37 | (defclass debug-report-callback (handle-mixin) 38 | ((callback-name :initarg :callback-name 39 | :reader callback-name) 40 | (instance :initarg :instance :reader instance) 41 | (allocator :initarg :allocator :reader allocator))) 42 | 43 | (defun create-debug-report-callback (instance callback-name 44 | &key (allocator +null-allocator+) 45 | (flags (logior VK_DEBUG_REPORT_ERROR_BIT_EXT 46 | VK_DEBUG_REPORT_WARNING_BIT_EXT 47 | VK_DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT))) 48 | (assert (typep instance 'instance)) 49 | ;; create the debug report callback 50 | (with-vk-struct (p-debug-report-create-info VkDebugReportCallbackCreateInfoEXT) 51 | (with-foreign-slots ((%vk::flags %vk::pfnCallback %vk::pUserData) 52 | p-debug-report-create-info (:struct VkDebugReportCallbackCreateInfoEXT)) 53 | (setf %vk::flags flags 54 | %vk::pfnCallback (get-callback callback-name) 55 | %vk::pUserData +nullptr+) 56 | (with-foreign-object (p-debug-report 'VkDebugReportCallbackEXT) 57 | (check-vk-result (vkCreateDebugReportCallbackEXT (h instance) (h instance) 58 | p-debug-report-create-info 59 | (h allocator) p-debug-report)) 60 | (let ((callback (make-instance 'debug-report-callback 61 | :handle (mem-aref p-debug-report 'VkDebugReportCallbackEXT) 62 | :callback-name callback-name 63 | :instance instance 64 | :allocator allocator))) 65 | callback))))) 66 | 67 | (defmethod destroy-debug-report-callback ((callback debug-report-callback)) 68 | (vkDestroyDebugReportCallbackEXT (h (instance callback)) (h (instance callback)) (h callback) (h (allocator callback)))) 69 | -------------------------------------------------------------------------------- /src/descriptor-pool.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-descriptor-pool (device &key (allocator +null-allocator+)) 25 | (let ((dp (create-descriptor-pool-1 device allocator 1000 26 | VK_DESCRIPTOR_TYPE_SAMPLER 27 | VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER 28 | VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE 29 | VK_DESCRIPTOR_TYPE_STORAGE_IMAGE 30 | VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER 31 | VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER 32 | VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER 33 | VK_DESCRIPTOR_TYPE_STORAGE_BUFFER 34 | VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC 35 | VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC 36 | VK_DESCRIPTOR_TYPE_INPUT_ATTACHMENT))) 37 | (push dp (descriptor-pools device)) 38 | dp)) 39 | 40 | (defun create-descriptor-pool-1 (device allocator descriptor-count &rest descriptor-types) 41 | (let ((pool-size-count (length descriptor-types))) 42 | (with-foreign-object (p-pool-sizes '(:struct VkDescriptorPoolSize) pool-size-count) 43 | (loop for i from 0 for descriptor-type in descriptor-types 44 | do (let ((p-pool-size (mem-aptr p-pool-sizes '(:struct VkDescriptorPoolSize) i))) 45 | (setf (foreign-slot-value p-pool-size '(:struct VkDescriptorPoolSize) '%vk::type) 46 | descriptor-type 47 | (foreign-slot-value p-pool-size '(:struct VkDescriptorPoolSize) '%vk::descriptorCount) 48 | descriptor-count))) 49 | (with-vk-struct (p-pool-info VkDescriptorPoolCreateInfo) 50 | (with-foreign-slots ((%vk::flags %vk::maxSets %vk::poolSizeCount %vk::pPoolSizes) 51 | p-pool-info (:struct VkDescriptorPoolCreateInfo)) 52 | (setf %vk::flags VK_DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT 53 | %vk::maxSets (* (length descriptor-types) descriptor-count) 54 | %vk::poolSizeCount pool-size-count 55 | %vk::pPoolSizes p-pool-sizes) 56 | (with-foreign-object (p-descriptor-pool 'VkDescriptorPool) 57 | (check-vk-result (vkCreateDescriptorPool (h device) p-pool-info (h allocator) p-descriptor-pool)) 58 | (make-instance 'descriptor-pool :handle (mem-aref p-descriptor-pool 'VkDescriptorPool) 59 | :device device :allocator allocator))))))) 60 | -------------------------------------------------------------------------------- /src/descriptor-set-layout.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-descriptor-set-layout (device &key (allocator +null-allocator+) 25 | (bindings (list (make-instance 'uniform-buffer-for-vertex-shader-dsl-binding)))) 26 | 27 | (let ((count (length bindings))) 28 | (let ((p-bindings (foreign-alloc '(:struct VkDescriptorSetLayoutBinding) :count count))) 29 | (unwind-protect 30 | (progn 31 | (loop for i from 0 below count 32 | do (zero-struct (mem-aptr p-bindings '(:struct VkDescriptorSetLayoutBinding) i) '(:struct VkDescriptorSetLayoutBinding))) 33 | (loop for binding in bindings 34 | for i from 0 35 | do (assert (typep binding 'descriptor-set-layout-binding)) 36 | (with-foreign-slots ((%vk::binding 37 | %vk::descriptorType 38 | %vk::descriptorCount 39 | %vk::stageFlags 40 | %vk::pImmutableSamplers) 41 | (mem-aptr p-bindings '(:struct VkDescriptorSetLayoutBinding) i) 42 | (:struct VkDescriptorSetLayoutBinding)) 43 | (let* ((is-count (length (immutable-samplers binding))) 44 | (p-immutable-samplers (foreign-alloc 'VkSampler :count is-count))) 45 | (loop for is in (immutable-samplers binding) for i from 0 46 | do (setf (mem-aref p-immutable-samplers 'VkSampler i) (h is))) 47 | (setf %vk::binding (binding binding) 48 | %vk::descriptorType (descriptor-type binding) 49 | %vk::descriptorCount (descriptor-count binding) 50 | %vk::stageFlags (stage-flags binding) 51 | %vk::pImmutableSamplers (if (immutable-samplers binding) 52 | p-immutable-samplers 53 | VK_NULL_HANDLE))))) 54 | (let ((p-layout-info (foreign-alloc '(:struct VkDescriptorSetLayoutCreateInfo)))) 55 | (zero-struct p-layout-info '(:struct VkDescriptorSetLayoutCreateInfo)) 56 | (with-foreign-slots ((%vk::sType 57 | %vk::bindingCount 58 | %vk::pBindings) 59 | p-layout-info (:struct VkDescriptorSetLayoutCreateInfo)) 60 | (setf %vk::sType VK_STRUCTURE_TYPE_DESCRIPTOR_SET_LAYOUT_CREATE_INFO 61 | %vk::bindingCount count 62 | %vk::pBindings p-bindings)) 63 | (with-foreign-object (p-descriptor-set-layout 'VkDescriptorSetLayout 1) 64 | (check-vk-result (vkCreateDescriptorSetLayout (h device) p-layout-info (h allocator) p-descriptor-set-layout)) 65 | (make-instance 'descriptor-set-layout :handle (mem-aref p-descriptor-set-layout 'VkDescriptorSetLayout 0) 66 | :device device :allocator allocator)))) 67 | (foreign-free p-bindings))))) 68 | 69 | (defun destroy-descriptor-set-layout (dsl) 70 | (with-slots (device allocator) dsl 71 | (vkDestroyDescriptorSetLayout (h device) (h dsl) (h allocator)))) 72 | -------------------------------------------------------------------------------- /src/descriptor-sets.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun allocate-descriptor-set (device descriptor-set-layouts descriptor-pool) 25 | (let ((dsl-count (length descriptor-set-layouts))) 26 | (with-foreign-object (p-descriptor-set-layouts 'VkDescriptorSetLayout dsl-count) 27 | (loop for dsl in descriptor-set-layouts for i from 0 28 | do (setf (mem-aref p-descriptor-set-layouts 'VkDescriptorSetLayout i) (h dsl))) 29 | (with-vk-struct (p-alloc-info VkDescriptorSetAllocateInfo) 30 | (with-foreign-slots ((%vk::descriptorPool 31 | %vk::descriptorSetCount 32 | %vk::pSetLayouts) 33 | p-alloc-info (:struct VkDescriptorSetAllocateInfo)) 34 | (setf %vk::descriptorPool (h descriptor-pool) 35 | %vk::descriptorSetCount dsl-count 36 | %vk::pSetLayouts p-descriptor-set-layouts) 37 | 38 | (with-foreign-object (p-descriptor-set 'VkDescriptorSet) 39 | (check-vk-result (vkAllocateDescriptorSets (h device) p-alloc-info p-descriptor-set)) 40 | (make-instance 'descriptor-set 41 | :handle (mem-aref p-descriptor-set 'VkDescriptorSet) 42 | :device device 43 | :descriptor-pool descriptor-pool))))))) 44 | 45 | (defun create-descriptor-set (device descriptor-set-layouts descriptor-pool 46 | &key descriptor-buffer-info 47 | descriptor-image-info) 48 | (create-descriptor-set-1 device descriptor-set-layouts descriptor-pool 49 | (append descriptor-buffer-info descriptor-image-info))) 50 | 51 | (defun create-descriptor-set-1 (device descriptor-set-layouts descriptor-pool descriptor-infos) 52 | ;; at some point make-descriptor-sets a frame resource, may work for now 53 | (let ((descriptor-set 54 | (allocate-descriptor-set device descriptor-set-layouts descriptor-pool)) 55 | (count (length descriptor-infos)) 56 | (free-list)) 57 | (with-foreign-object (p-writes '(:struct VkWriteDescriptorSet) count) 58 | (loop for i from 0 below count 59 | do (zero-struct (mem-aptr p-writes '(:struct VkWriteDescriptorSet) i) 60 | '(:struct VkWriteDescriptorSet))) 61 | (flet ((alloc-image-info (info) 62 | (let ((p-info (foreign-alloc '(:struct VkDescriptorImageInfo)))) 63 | (with-foreign-slots ((%vk::imageLayout 64 | %vk::imageView 65 | %vk::sampler) 66 | p-info 67 | (:struct VkDescriptorImageInfo)) 68 | (setf %vk::imageLayout VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL 69 | %vk::imageView (h (slot-value info 'image-view)) 70 | %vk::sampler (h (slot-value info 'sampler))) 71 | (push p-info free-list) 72 | p-info))) 73 | 74 | (alloc-buffer-info (info) 75 | (let ((p-info (foreign-alloc '(:struct VkDescriptorBufferInfo)))) 76 | (with-foreign-slots ((%vk::buffer 77 | %vk::offset 78 | %vk::range) 79 | p-info 80 | (:struct VkDescriptorBufferInfo)) 81 | (setf %vk::buffer (h (buffer info)) 82 | %vk::offset (offset info) 83 | %vk::range (range info)) 84 | (push p-info free-list) 85 | p-info)))) 86 | 87 | (unwind-protect 88 | (progn 89 | (loop for i from 0 for info in descriptor-infos 90 | do (let* ((type (etypecase info 91 | (descriptor-buffer-info :buffer) 92 | (descriptor-image-info :image))) 93 | (p-info (case type 94 | (:buffer (alloc-buffer-info info)) 95 | (:image (alloc-image-info info)))) 96 | (p-write (mem-aptr p-writes '(:struct VkWriteDescriptorSet) i))) 97 | (with-foreign-slots ((%vk::sType 98 | %vk::dstSet 99 | %vk::dstBinding 100 | %vk::dstArrayElement 101 | %vk::descriptorType 102 | %vk::descriptorCount 103 | %vk::pBufferInfo 104 | %vk::pImageInfo 105 | %vk::pTexelBufferView) 106 | p-write 107 | (:struct VkWriteDescriptorSet)) 108 | (setf %vk::sType VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET 109 | %vk::dstSet (h descriptor-set) 110 | %vk::dstBinding i 111 | %vk::dstArrayElement 0 112 | %vk::descriptorType (descriptor-type info) 113 | %vk::descriptorCount 1 114 | %vk::pBufferInfo (if (eq type :buffer) 115 | p-info 116 | +nullptr+) 117 | %vk::pImageInfo (if (eq type :image) 118 | p-info 119 | +nullptr+) 120 | %vk::pTexelBufferView +nullptr+)))) 121 | (vkUpdateDescriptorSets (h device) count p-writes 0 +nullptr+)) 122 | (mapcar #'foreign-free free-list)) 123 | descriptor-set)))) 124 | 125 | (defun free-descriptor-sets (descriptor-sets descriptor-pool) 126 | (with-slots (device) descriptor-pool 127 | (let ((count (length descriptor-sets))) 128 | (with-foreign-object (p-descriptor-sets 'VkDescriptorSet count) 129 | (loop for ds in descriptor-sets for i from 0 130 | do (setf (mem-aref p-descriptor-sets 'VkDescriptorSet i) (h ds)) 131 | finally (vkFreeDescriptorSets (h device) (h descriptor-pool) count p-descriptor-sets))))) 132 | (values)) 133 | -------------------------------------------------------------------------------- /src/fence.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (defmacro with-fences ((swapchain) &body body) 4 | (let ((fence-sym (gensym)) 5 | (swapchain-sym (gensym)) 6 | (result-sym (gensym)) 7 | (break-sym (gensym)) 8 | (continue-sym (gensym))) 9 | `(let* ((,swapchain-sym ,swapchain) 10 | (,fence-sym (fence (elt (frame-resources ,swapchain-sym) (current-frame ,swapchain-sym))))) 11 | 12 | (tagbody 13 | ,continue-sym 14 | (let ((,result-sym 15 | (with-foreign-object (p-fences 'VkFence) 16 | (setf (mem-aref p-fences 'VkFence) (h ,fence-sym)) 17 | (vkWaitForFences (h (device ,swapchain-sym)) 1 p-fences VK_TRUE 100)))) 18 | 19 | ;; probably can set wait time to uint32 max and eliminate this tagbody 20 | (when (eq ,result-sym VK_SUCCESS) 21 | (go ,break-sym)) 22 | (when (eq ,result-sym VK_TIMEOUT) 23 | (go ,continue-sym)) 24 | (check-vk-result ,result-sym)) 25 | 26 | ,break-sym 27 | ,@body)))) 28 | -------------------------------------------------------------------------------- /src/framebuffer.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | #+NIL 25 | (defcallback resize-framebuffer-callback :void ((window :pointer) (w :int) (h :int)) 26 | (resize-framebuffer (find-window window) w h)) 27 | 28 | #+NIL 29 | (defun set-framebuffer-size-callback (window &optional (callback-name 'resize-framebuffer-callback)) 30 | (glfwSetFramebufferSizeCallback (h window) (get-callback callback-name))) 31 | 32 | #+NIL 33 | (defun create-framebuffer (device render-pass swapchain index &key (allocator +null-allocator+)) 34 | (with-foreign-object (p-attachments 'VkImageView 3) 35 | (setf (mem-aref p-attachments 'VkImageView 0) (h (elt (color-image-views swapchain) index)) 36 | (mem-aref p-attachments 'VkImageView 1) (h (first (depth-image-views swapchain))) 37 | (mem-aref p-attachments 'VkImageView 2) (h (multisample-image-view swapchain))) 38 | 39 | (with-vk-struct (p-info VkFramebufferCreateInfo) 40 | (with-foreign-slots ((%vk::renderPass 41 | %vk::attachmentCount 42 | %vk::pAttachments 43 | %vk::width 44 | %vk::height 45 | %vk::layers) 46 | p-info (:struct VkFramebufferCreateInfo)) 47 | (setf %vk::renderPass (h render-pass) 48 | %vk::attachmentCount 3 49 | %vk::pAttachments p-attachments 50 | %vk::width (fb-width swapchain) 51 | %vk::height (fb-height swapchain) 52 | %vk::layers 1) 53 | 54 | (with-foreign-object (p-framebuffer 'VkFramebuffer) 55 | (check-vk-result 56 | (vkCreateFramebuffer (h device) p-info (h allocator) p-framebuffer)) 57 | (make-instance 'framebuffer :handle (mem-aref p-framebuffer 'VkFramebuffer) 58 | :device device :allocator allocator)))))) 59 | 60 | (defun create-framebuffer2 (device render-pass swapchain index &key (allocator +null-allocator+)) 61 | (with-foreign-object (p-attachments 'VkImageView 4) 62 | (setf (mem-aref p-attachments 'VkImageView 0) (h (multisample-image-view swapchain)) 63 | (mem-aref p-attachments 'VkImageView 1) (h (first (depth-image-views swapchain))) 64 | (mem-aref p-attachments 'VkImageView 2) (h (second (depth-image-views swapchain))) 65 | (mem-aref p-attachments 'VkImageView 3) (h (elt (color-image-views swapchain) index)) 66 | ) 67 | 68 | (with-vk-struct (p-info VkFramebufferCreateInfo) 69 | (with-foreign-slots ((%vk::renderPass 70 | %vk::attachmentCount 71 | %vk::pAttachments 72 | %vk::width 73 | %vk::height 74 | %vk::layers) 75 | p-info (:struct VkFramebufferCreateInfo)) 76 | (setf %vk::renderPass (h render-pass) 77 | %vk::attachmentCount 4 78 | %vk::pAttachments p-attachments 79 | %vk::width (fb-width swapchain) 80 | %vk::height (fb-height swapchain) 81 | %vk::layers 1) 82 | 83 | (with-foreign-object (p-framebuffer 'VkFramebuffer) 84 | (check-vk-result 85 | (vkCreateFramebuffer (h device) p-info (h allocator) p-framebuffer)) 86 | (make-instance 'framebuffer :handle (mem-aref p-framebuffer 'VkFramebuffer) 87 | :device device :allocator allocator)))))) 88 | 89 | (defun setup-framebuffers (device render-pass swapchain &key (allocator +null-allocator+)) 90 | (let* ((count (length (images swapchain))) 91 | (array (make-array count))) 92 | (loop for i from 0 below count 93 | do (setf (elt array i) (create-framebuffer2 device render-pass swapchain i :allocator allocator)) 94 | finally (setf (framebuffers swapchain) array))) 95 | (values)) 96 | 97 | (defmethod resize-framebuffer (window width height) 98 | ;; imgui docking branch just sets a flag and does actual resize buffer in the 99 | ;; beginning of the render loop. Could avoid certain errors. Consider changing. 100 | (setf (recreate-swapchain? window) t 101 | (new-width window) width 102 | (new-height window) height) 103 | (values)) 104 | 105 | (defun destroy-framebuffers (swapchain) 106 | (with-slots (device) swapchain 107 | (with-slots (allocator) device 108 | (let ((framebuffers (framebuffers swapchain)) 109 | (device-handle (h device)) 110 | (allocator-handle (h allocator))) 111 | (when framebuffers 112 | (loop for framebuffer across framebuffers 113 | do (vkDestroyFramebuffer device-handle (h framebuffer) allocator-handle) 114 | finally (setf (framebuffers swapchain) nil)))))) 115 | (values)) 116 | 117 | (defun destroy-framebuffer (framebuffer) 118 | (vkDestroyFramebuffer (h (device framebuffer)) (h framebuffer) (h (allocator framebuffer))) 119 | (values)) 120 | -------------------------------------------------------------------------------- /src/graphics-pipeline.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defcstruct vec2 25 | (a :float) 26 | (b :float)) 27 | 28 | (defcstruct vec3 29 | (a :float) 30 | (b :float) 31 | (c :float)) 32 | 33 | (defcstruct Vertex 34 | (pos (:struct vec3)) 35 | (color (:struct vec3))) 36 | 37 | (defun create-graphics-pipeline (device pipeline-cache pipeline-layout render-pass back-buffer-count vertex-shader-module fragment-shader-module 38 | ;; todo: make create-pipeline configurable on vertex input attribute description options 39 | &rest args 40 | &key (allocator +null-allocator+) 41 | (geometry-shader-module nil) 42 | (tessellation-control-shader-module nil) 43 | (tessellation-evaluation-shader-module nil) 44 | (vertex-type '(:struct Vertex)) 45 | (vertex-size (if vertex-type (foreign-type-size vertex-type) 0)) 46 | (vertex-input-attribute-descriptions 47 | (list (make-instance 'vertex-input-attribute-description 48 | :location 0 49 | :offset (foreign-slot-offset vertex-type 'pos)) 50 | (make-instance 'vertex-input-attribute-description 51 | :location 1 52 | :offset (foreign-slot-offset vertex-type 'color)))) 53 | &allow-other-keys) 54 | (declare (ignore back-buffer-count)) 55 | (let ((shader-module-count (length (remove-if #'null (list vertex-shader-module fragment-shader-module geometry-shader-module 56 | tessellation-control-shader-module tessellation-evaluation-shader-module))))) 57 | (with-foreign-object (p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) shader-module-count) 58 | (let ((i -1)) 59 | 60 | (when vertex-shader-module 61 | (fill-pipeline-shader-stage-create-info (mem-aptr p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) (incf i)) 62 | :stage VK_SHADER_STAGE_VERTEX_BIT 63 | :module vertex-shader-module)) 64 | (when fragment-shader-module 65 | (fill-pipeline-shader-stage-create-info (mem-aptr p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) (incf i)) 66 | :stage VK_SHADER_STAGE_FRAGMENT_BIT 67 | :module fragment-shader-module)) 68 | (when geometry-shader-module 69 | (fill-pipeline-shader-stage-create-info (mem-aptr p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) (incf i)) 70 | :stage VK_SHADER_STAGE_GEOMETRY_BIT 71 | :module geometry-shader-module)) 72 | (when tessellation-control-shader-module 73 | (fill-pipeline-shader-stage-create-info (mem-aptr p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) (incf i)) 74 | :stage VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT 75 | :module tessellation-control-shader-module)) 76 | (when tessellation-evaluation-shader-module 77 | (fill-pipeline-shader-stage-create-info (mem-aptr p-shader-stages '(:struct VkPipelineShaderStageCreateInfo) (incf i)) 78 | :stage VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT 79 | :module tessellation-evaluation-shader-module))) 80 | (with-vertex-input-binding-description (p-vibd) 81 | (apply #'fill-vertex-input-binding-description p-vibd (append args (list :stride vertex-size))) 82 | (with-foreign-object (p-attribute-descriptions '(:struct VkVertexInputAttributeDescription) 83 | (length vertex-input-attribute-descriptions)) 84 | (loop for description in vertex-input-attribute-descriptions 85 | for i from 0 86 | do (fill-vertex-input-attribute-description 87 | (mem-aptr p-attribute-descriptions '(:struct VkVertexInputAttributeDescription) i) 88 | :location (location description) 89 | :binding (binding description) 90 | :format (desc-format description) 91 | :offset (offset description))) 92 | (with-pipeline-vertex-input-state-create-info (p-pvisci) 93 | (apply #'fill-pipeline-vertex-input-state-create-info p-pvisci 94 | :vertex-binding-description-count (if vertex-type 1 0) 95 | :p-vertex-binding-descriptions (if vertex-type p-vibd +nullptr+) 96 | :vertex-attribute-description-count (length vertex-input-attribute-descriptions) 97 | :p-vertex-attribute-descriptions (if vertex-type p-attribute-descriptions +nullptr+) 98 | args) 99 | 100 | (with-pipeline-input-assembly-state-create-info (p-piasci) 101 | (apply #'fill-pipeline-input-assembly-state-create-info p-piasci args) 102 | 103 | (with-viewport-structure (p-viewport) 104 | (apply #'fill-viewport-structure p-viewport args) 105 | 106 | (with-scissor-structure (p-scissor) 107 | (apply #'fill-scissor-structure p-scissor args) 108 | 109 | (with-pipeline-viewport-state-create-info (p-viewport-state) 110 | (apply #'fill-pipeline-viewport-state-create-info p-viewport-state 111 | :viewport-count 1 112 | :p-viewports +nullptr+ ;; p-viewport 113 | :scissor-count 1 114 | :p-scissors +nullptr+ ;;p-scissor 115 | args) 116 | 117 | (with-pipeline-rasterization-line-state-create-info-ext (p-lscie) 118 | (apply #'fill-pipeline-rasterization-line-state-create-info-ext 119 | p-lscie :lineRasterizationMode %vk::VK_LINE_RASTERIZATION_MODE_RECTANGULAR_EXT args) 120 | 121 | (with-pipeline-rasterization-state-create-info (p-rasterizer) 122 | (apply #'fill-pipeline-rasterization-state-create-info p-rasterizer 123 | args) 124 | (when (and (getf args :stippled-line-enable) 125 | (not (zerop (getf args :stippled-line-enable)))) 126 | (setf (foreign-slot-value p-rasterizer 127 | '(:struct VkPipelineRasterizationStateCreateInfo) 128 | '%vk::pNext) p-lscie)) 129 | 130 | (with-pipeline-multisample-state-create-info (p-multisampling) 131 | (apply #'fill-pipeline-multisample-state-create-info p-multisampling args) 132 | 133 | (with-foreign-object (p-color-blend-attachments 134 | '(:struct VkPipelineColorBlendAttachmentState)) 135 | (apply #'fill-pipeline-color-blend-attachment-state 136 | p-color-blend-attachments args) 137 | 138 | (with-pipeline-color-blend-state-create-info (p-color-blending) 139 | (apply #'fill-pipeline-color-blend-state-create-info p-color-blending 140 | :p-attachments p-color-blend-attachments 141 | :attachment-count 1 142 | args) 143 | (let ((dynamic-state-count 144 | #-(or darwin) 4 145 | #+(or darwin) 2)) 146 | (with-dynamic-states (p-dynamic-states dynamic-state-count) 147 | 148 | (setf (mem-aref p-dynamic-states 'VkDynamicState 0) VK_DYNAMIC_STATE_VIEWPORT 149 | (mem-aref p-dynamic-states 'VkDynamicState 1) VK_DYNAMIC_STATE_SCISSOR) 150 | #-(or darwin) 151 | (setf (mem-aref p-dynamic-states 'VKDynamicState 2) %vk::VK_DYNAMIC_STATE_LINE_STIPPLE_EXT 152 | (mem-aref p-dynamic-states 'VKDynamicState 3) VK_DYNAMIC_STATE_LINE_WIDTH) 153 | 154 | (with-pipeline-dynamic-state-create-info (p-pipeline-dynamic-state-ci) 155 | (apply #'fill-pipeline-dynamic-state-create-info p-pipeline-dynamic-state-ci 156 | :dynamic-state-count dynamic-state-count 157 | :p-dynamic-states p-dynamic-states args) 158 | 159 | (with-pipeline-depth-stencil-state-create-info (p-depth-stencil) 160 | (apply #'fill-pipeline-depth-stencil-state-create-info p-depth-stencil args) 161 | (with-graphics-pipeline-create-info (p-pipeline-ci) 162 | (apply #'fill-graphics-pipeline-create-info p-pipeline-ci 163 | :stage-count shader-module-count 164 | :p-stages p-shader-stages 165 | :p-vertex-input-state p-pvisci 166 | :p-input-assembly-state p-piasci 167 | :p-viewport-state p-viewport-state 168 | :p-rasterization-state p-rasterizer 169 | :p-multisample-state p-multisampling 170 | :p-depth-stencil-state p-depth-stencil 171 | :p-color-blend-state p-color-blending 172 | :p-dynamic-state p-pipeline-dynamic-state-ci 173 | :layout (h pipeline-layout) 174 | :render-pass (h render-pass) 175 | args) 176 | 177 | (with-foreign-object (p-graphics-pipeline 'VkPipeline) 178 | (check-vk-result 179 | (vkCreateGraphicsPipelines 180 | (h device) (h pipeline-cache) 1 p-pipeline-ci (h allocator) p-graphics-pipeline)) 181 | (make-instance 'graphics-pipeline :handle (mem-aref p-graphics-pipeline 'VkPipeline) 182 | :device device 183 | :allocator allocator 184 | :vertex-shader vertex-shader-module 185 | :geometry-shader geometry-shader-module 186 | :fragment-shader fragment-shader-module)))))))))))))))))))))) 187 | 188 | (defun destroy-pipeline (pipeline) 189 | (with-slots (device allocator) pipeline 190 | (vkDestroyPipeline (h device) (h pipeline) (h allocator))) 191 | (values)) 192 | -------------------------------------------------------------------------------- /src/image-views.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-image-view (device image &key (allocator +null-allocator+) 25 | (view-type VK_IMAGE_VIEW_TYPE_2D) 26 | (format VK_FORMAT_B8G8R8A8_UNORM) 27 | (aspect-mask VK_IMAGE_ASPECT_COLOR_BIT) 28 | (base-mip-level 0) 29 | (level-count 1) 30 | (base-array-layer 0) 31 | (layer-count 1)) 32 | (with-vk-struct (p-view-info VkImageViewCreateInfo) 33 | (with-foreign-slots ((%vk::image 34 | %vk::viewType 35 | %vk::format) 36 | p-view-info 37 | (:struct VkImageViewCreateInfo)) 38 | (with-foreign-slots ((%vk::aspectMask 39 | %vk::baseMipLevel %vk::levelCount 40 | %vk::baseArrayLayer %vk::layerCount) 41 | (foreign-slot-pointer p-view-info 42 | '(:struct VkImageViewCreateInfo) 43 | '%vk::subresourceRange) 44 | (:struct VKImageSubresourceRange)) 45 | (setf %vk::image (h image) 46 | %vk::viewType view-type 47 | %vk::format format 48 | 49 | %vk::aspectMask aspect-mask 50 | %vk::baseMipLevel base-mip-level 51 | %vk::levelCount level-count 52 | %vk::baseArrayLayer base-array-layer 53 | %vk::layerCount layer-count) 54 | 55 | (with-foreign-object (p-image-view 'VkImageView) 56 | (check-vk-result (vkCreateImageView (h device) p-view-info (h allocator) p-image-view)) 57 | (make-instance 'image-view :handle (mem-aref p-image-view 'VkImageView) 58 | :device device 59 | :image image 60 | :allocator allocator)))))) 61 | 62 | (defun create-depth-image-view (device image &key (allocator +null-allocator+) 63 | (format (find-supported-depth-format 64 | (physical-device device))) 65 | (aspect-mask VK_IMAGE_ASPECT_DEPTH_BIT)) 66 | (create-image-view device image :format format :aspect-mask aspect-mask :allocator allocator)) 67 | 68 | (defun create-image-views (swapchain &key 69 | (allocator +null-allocator+) 70 | (view-type VK_IMAGE_VIEW_TYPE_2D) 71 | (aspect-mask VK_IMAGE_ASPECT_COLOR_BIT) 72 | (base-mip-level 0) 73 | (level-count 1) 74 | (base-array-layer 0) 75 | (layer-count 1)) 76 | 77 | (let* ((count (number-of-images swapchain)) 78 | (image-views (make-array count))) 79 | (with-vk-struct (p-image-range VkImageSubresourceRange) 80 | (with-foreign-slots ((%vk::aspectMask 81 | %vk::baseMipLevel 82 | %vk::levelCount 83 | %vk::baseArrayLayer 84 | %vk::layerCount) 85 | p-image-range 86 | (:struct VkImageSubresourceRange)) 87 | 88 | (setf %vk::aspectMask aspect-mask 89 | %vk::baseMipLevel base-mip-level 90 | %vk::levelCount level-count 91 | %vk::baseArrayLayer base-array-layer 92 | %vk::layerCount layer-count)) 93 | 94 | (with-vk-struct (p-create-info VkImageViewCreateInfo) 95 | (with-foreign-slots ((%vk::sType 96 | %vk::viewType 97 | %vk::format 98 | %vk::subresourceRange) 99 | p-create-info 100 | (:struct VkImageViewCreateInfo)) 101 | (with-foreign-slots ((%vk::r %vk::g %vk::b %vk::a) 102 | (foreign-slot-pointer p-create-info '(:struct VkImageViewCreateInfo) 103 | '%vk::components) 104 | (:struct VkComponentMapping)) 105 | 106 | (setf %vk::viewType view-type 107 | %vk::format (surface-format-format (surface-format swapchain)) 108 | %vk::r VK_COMPONENT_SWIZZLE_R 109 | %vk::g VK_COMPONENT_SWIZZLE_G 110 | %vk::b VK_COMPONENT_SWIZZLE_B 111 | %vk::a VK_COMPONENT_SWIZZLE_A 112 | %vk::subresourceRange p-image-range))) 113 | 114 | (loop for i from 0 below count 115 | do (setf (foreign-slot-value p-create-info '(:struct VkImageViewCreateInfo) '%vk::image) 116 | (h (elt (images swapchain) i))) 117 | (with-foreign-object (p-image-view 'VkImageView) 118 | (check-vk-result (vkCreateImageView (h (device swapchain)) p-create-info (h allocator) p-image-view)) 119 | (setf (elt image-views i) (make-instance 'image-view 120 | :device (device swapchain) 121 | :handle (mem-aref p-image-view 'VkImageView) 122 | :image (elt (images swapchain) i) 123 | :allocator allocator)))))) 124 | image-views)) 125 | 126 | (defun destroy-image-view (image-view) 127 | (vkDestroyImageView (h (device image-view)) (h image-view) (h (allocator image-view))) 128 | (values)) 129 | -------------------------------------------------------------------------------- /src/images.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | 25 | 26 | (defun create-image (device width height &key (allocator +null-allocator+) 27 | (image-class 'image) 28 | (samples VK_SAMPLE_COUNT_1_BIT) 29 | (format VK_FORMAT_B8G8R8A8_UNORM) 30 | (tiling VK_IMAGE_TILING_OPTIMAL) 31 | (usage (logior VK_IMAGE_USAGE_SAMPLED_BIT 32 | VK_IMAGE_USAGE_TRANSFER_DST_BIT)) 33 | (memory-properties VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT)) 34 | (with-vk-struct (p-info VkImageCreateInfo) 35 | (with-foreign-slots ((%vk::imageType 36 | %vk::mipLevels 37 | %vk::arrayLayers 38 | %vk::format 39 | %vk::tiling 40 | %vk::initialLayout 41 | %vk::usage 42 | %vk::samples 43 | %vk::sharingMode) 44 | p-info (:struct VkImageCreateInfo)) 45 | (setf %vk::imageType VK_IMAGE_TYPE_2D 46 | %vk::format format 47 | %vk::mipLevels 1 48 | %vk::arrayLayers 1 49 | %vk::samples samples 50 | %vk::tiling tiling 51 | %vk::usage usage 52 | %vk::sharingMode VK_SHARING_MODE_EXCLUSIVE 53 | %vk::initialLayout VK_IMAGE_LAYOUT_UNDEFINED 54 | 55 | (foreign-slot-value 56 | (foreign-slot-pointer p-info '(:struct VkImageCreateInfo) '%vk::extent) 57 | '(:struct VkExtent3D) '%vk::width) width 58 | 59 | (foreign-slot-value 60 | (foreign-slot-pointer p-info '(:struct VkImageCreateInfo) '%vk::extent) 61 | '(:struct VkExtent3D) '%vk::height) height 62 | 63 | (foreign-slot-value 64 | (foreign-slot-pointer p-info '(:struct VkImageCreateInfo) '%vk::extent) 65 | '(:struct VkExtent3D) '%vk::depth) 1) 66 | 67 | (with-foreign-object (p-image 'VkImage) 68 | (check-vk-result (vkCreateImage (h device) p-info (h allocator) p-image)) 69 | (with-vk-struct (p-req VkMemoryRequirements) 70 | (vkGetImageMemoryRequirements (h device) (mem-aref p-image 'VkImage) p-req) 71 | (with-vk-struct (p-alloc-info VkMemoryAllocateInfo) 72 | (with-foreign-slots ((%vk::size 73 | %vk::memoryTypeBits) 74 | p-req 75 | (:struct VkMemoryRequirements)) 76 | (with-foreign-slots ((%vk::allocationSize 77 | %vk::memoryTypeIndex) 78 | p-alloc-info 79 | (:struct VkMemoryAllocateInfo)) 80 | (setf %vk::allocationSize %vk::size 81 | %vk::memoryTypeIndex (find-memory-type (physical-device device) 82 | %vk::memoryTypeBits 83 | memory-properties)))) 84 | (with-foreign-object (p-memory 'VkDeviceMemory) 85 | (check-vk-result (vkAllocateMemory (h device) p-alloc-info (h allocator) p-memory)) 86 | (vkBindImageMemory (h device) (mem-aref p-image 'VkImage) (mem-aref p-memory 'VkDeviceMemory) 0) 87 | (make-instance image-class 88 | :handle (mem-aref p-image 'VkImage) 89 | :memory (make-instance 'allocated-memory 90 | :handle (mem-aref p-memory 'VkDeviceMemory) 91 | :device device 92 | :allocator allocator) 93 | :device device :allocator allocator)))))))) 94 | 95 | (defun create-depth-image (device width height &key (allocator +null-allocator+) 96 | (format (find-supported-depth-format 97 | (physical-device device))) 98 | (samples VK_SAMPLE_COUNT_1_BIT) 99 | (tiling VK_IMAGE_TILING_OPTIMAL) 100 | (usage VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT) 101 | (memory-properties VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT)) 102 | (create-image device width height 103 | :image-class 'depth-image 104 | :allocator allocator 105 | :format format 106 | :samples samples 107 | :tiling tiling 108 | :usage usage 109 | :memory-properties memory-properties)) 110 | 111 | (defun destroy-image (image) 112 | (vkDestroyImage (h (device image)) (h image) (h (allocator image))) 113 | (vkFreeMemory (h (device image)) (h (allocated-memory image)) (h (allocator (allocated-memory image)))) 114 | (values)) 115 | 116 | (defmethod transition-image-layout (device image command-pool &key format old-layout new-layout) 117 | (let ((command-buffer (begin-single-time-commands device command-pool))) 118 | (with-vk-struct (p-barrier VkImageMemoryBarrier) 119 | (with-foreign-slots ((%vk::oldLayout 120 | %vk::newLayout 121 | %vk::srcQueueFamilyIndex 122 | %vk::dstQueueFamilyIndex 123 | %vk::srcAccessMask 124 | %vk::dstAccessMask 125 | %vk::image) 126 | p-barrier (:struct VkImageMemoryBarrier)) 127 | (setf %vk::oldLayout old-layout 128 | %vk::newLayout new-layout 129 | %vk::srcQueueFamilyIndex VK_QUEUE_FAMILY_IGNORED 130 | %vk::dstQueueFamilyIndex VK_QUEUE_FAMILY_IGNORED 131 | %vk::image image) 132 | 133 | (if (eq new-layout VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL) 134 | (progn 135 | (setf (foreign-slot-value 136 | (foreign-slot-pointer 137 | p-barrier '(:struct VkImageMemoryBarrier) 138 | '%vk::subresourceRange) 139 | '(:struct VKImageSubresourceRange) 140 | '%vk::aspectMask) 141 | VK_IMAGE_ASPECT_DEPTH_BIT) 142 | (when (has-stencil-component-p format) 143 | (setf (foreign-slot-value 144 | (foreign-slot-pointer 145 | p-barrier '(:struct VkImageMemoryBarrier) 146 | '%vk::subresourceRange) 147 | '(:struct VKImageSubresourceRange) 148 | '%vk::aspectMask) 149 | (logior (foreign-slot-value 150 | (foreign-slot-pointer 151 | p-barrier '(:struct VkImageMemoryBarrier) 152 | '%vk::subresourceRange) 153 | '(:struct VKImageSubresourceRange) 154 | '%vk::aspectMask) 155 | VK_IMAGE_ASPECT_STENCIL_BIT)))) 156 | (setf (foreign-slot-value 157 | (foreign-slot-pointer 158 | p-barrier '(:struct VkImageMemoryBarrier) 159 | '%vk::subresourceRange) 160 | '(:struct VKImageSubresourceRange) 161 | '%vk::aspectMask) 162 | VK_IMAGE_ASPECT_COLOR_BIT)) 163 | 164 | (with-foreign-slots ((%vk::baseMipLevel 165 | %vk::levelCount 166 | %vk::baseArrayLayer 167 | %vk::layerCount) 168 | (foreign-slot-pointer 169 | p-barrier '(:struct VkImageMemoryBarrier) 170 | '%vk::subresourceRange) 171 | (:struct VkImageSubresourceRange)) 172 | (setf %vk::baseMipLevel 0 173 | %vk::levelCount 1 174 | %vk::baseArrayLayer 0 175 | %vk::layerCount 1)) 176 | 177 | (let ((source-stage) 178 | (destination-stage)) 179 | (if (and (eq old-layout VK_IMAGE_LAYOUT_UNDEFINED) 180 | (eq new-layout VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL)) 181 | (setf %vk::srcAccessMask 0 182 | %vk::dstAccessMask VK_ACCESS_TRANSFER_WRITE_BIT 183 | 184 | source-stage VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT 185 | destination-stage VK_PIPELINE_STAGE_TRANSFER_BIT) 186 | (if (and (eq old-layout VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL) 187 | (eq new-layout VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL)) 188 | (setf %vk::srcAccessMask VK_ACCESS_TRANSFER_WRITE_BIT 189 | %vk::dstAccessMask VK_ACCESS_SHADER_READ_BIT 190 | 191 | source-stage VK_PIPELINE_STAGE_TRANSFER_BIT 192 | destination-stage VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT) 193 | (if (and (eq old-layout VK_IMAGE_LAYOUT_UNDEFINED) 194 | (eq new-layout VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL)) 195 | 196 | (setf %vk::srcAccessMask 0 197 | %vk::dstAccessMask (logior VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_READ_BIT 198 | VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT) 199 | source-stage VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT 200 | destination-stage VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) 201 | (error "unsupported layout transition")))) 202 | (vkCmdPipelineBarrier (h command-buffer) source-stage destination-stage 203 | 0 0 +nullptr+ 0 +nullptr+ 1 p-barrier) 204 | ;; todo: change first second first device-queues device to something sane 205 | (end-single-time-commands device command-pool (first (second (first (device-queues device)))) command-buffer)))))) 206 | -------------------------------------------------------------------------------- /src/macros.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defmacro with-vertex-input-binding-description ((var) 25 | &body body) 26 | 27 | `(with-vk-struct (,var VkVertexInputBindingDescription) 28 | 29 | ,@body)) 30 | 31 | (defmacro with-pipeline-vertex-input-state-create-info ((var) 32 | &body body) 33 | `(with-vk-struct (,var VkPipelineVertexInputStateCreateInfo) 34 | 35 | ,@body)) 36 | 37 | (defmacro with-pipeline-input-assembly-state-create-info ((var) &body body) 38 | `(with-vk-struct (,var VkPipelineInputAssemblyStateCreateInfo) 39 | ,@body)) 40 | 41 | (defmacro with-viewport-structure ((var) &body body) 42 | `(with-vk-struct (,var VkViewport) 43 | ,@body)) 44 | 45 | (defmacro with-scissor-structure ((var) &body body) 46 | `(with-vk-struct (,var VkRect2D) 47 | ,@body)) 48 | 49 | (defmacro with-pipeline-viewport-state-create-info ((var) &body body) 50 | `(with-vk-struct (,var VkPipelineViewportStateCreateInfo) 51 | ,@body)) 52 | 53 | (defmacro with-pipeline-rasterization-state-create-info ((var) &body body) 54 | `(with-vk-struct (,var VkPipelineRasterizationStateCreateInfo) 55 | 56 | ,@body)) 57 | 58 | (defmacro with-pipeline-rasterization-line-state-create-info-ext ((var) &body body) 59 | `(with-vk-struct (,var VkPipelineRasterizationLineStateCreateInfoEXT) 60 | ,@body)) 61 | 62 | (defmacro with-pipeline-multisample-state-create-info ((var) &body body) 63 | 64 | `(with-vk-struct (,var VKPipelineMultisampleStateCreateInfo) 65 | ,@body)) 66 | 67 | (defmacro with-graphics-pipeline-create-info ((var) &body body) 68 | `(with-vk-struct (,var VkGraphicsPipelineCreateInfo) 69 | ,@body)) 70 | 71 | (defmacro with-pipeline-depth-stencil-state-create-info ((var) &body body) 72 | `(with-vk-struct (,var VkPipelineDepthStencilStateCreateInfo) 73 | ,@body)) 74 | 75 | (defmacro with-descriptor-set-layouts ((var count) &body body) 76 | `(with-foreign-object (,var 'VkDescriptorSetLayout ,count) 77 | ,@body)) 78 | 79 | (defmacro with-pipeline-layout-create-info ((var) &body body) 80 | `(with-vk-struct (,var VkPipelineLayoutCreateInfo) 81 | ,@body)) 82 | 83 | (defmacro with-pipeline-dynamic-state-create-info ((var) &body body) 84 | `(with-vk-struct (,var VkPipelineDynamicStateCreateInfo) 85 | ,@body)) 86 | 87 | (defmacro with-dynamic-states ((var count) &body body) 88 | `(with-foreign-object (,var 'VkDynamicState ,count) 89 | ,@body)) 90 | 91 | (defmacro with-pipeline-color-blend-state-create-info ((var) &body body) 92 | `(with-vk-struct (,var VkPipelineColorBlendStateCreateInfo) 93 | ,@body)) 94 | 95 | (defmacro api-version (major minor patch) 96 | `(logior (ash ,major 22) (ash ,minor 12) ,patch)) 97 | 98 | (defmacro with-viewport ((var &key width height 99 | (x 0.0f0) 100 | (y 0.0f0) 101 | (min-depth 0.0f0) 102 | (max-depth 1.0f0)) 103 | &body body) 104 | `(with-vk-struct (,var VkViewport) 105 | (with-foreign-slots ((%vk::x 106 | %vk::y 107 | %vk::width 108 | %vk::height 109 | %vk::minDepth 110 | %vk::maxDepth) 111 | ,var 112 | (:struct VkViewport)) 113 | (setf %vk::x (clampf ,x) 114 | %vk::y (clampf ,y) 115 | %vk::width (clampf ,width) 116 | %vk::height (clampf ,height) 117 | %vk::minDepth (clampf ,min-depth) 118 | %vk::maxDepth (clampf ,max-depth)) 119 | ,@body))) 120 | 121 | (defmacro with-scissor ((var &key width height 122 | (x 0) (y 0)) 123 | &body body) 124 | (let ((p-offset-sym (gensym "P-OFFSET-")) 125 | (p-extent-sym (gensym "P-EXTENT-")) 126 | (width-sym (gensym "WIDTH-")) 127 | (height-sym (gensym "HEIGHT-")) 128 | (x-sym (gensym "X-")) 129 | (y-sym (gensym "Y-"))) 130 | `(let ((,x-sym ,x) 131 | (,y-sym ,y) 132 | (,width-sym ,width) 133 | (,height-sym ,height)) 134 | (with-vk-struct (,var VkRect2D) 135 | (let ((,p-offset-sym 136 | (foreign-slot-pointer ,var '(:struct VkRect2D) '%vk::offset)) 137 | (,p-extent-sym 138 | (foreign-slot-pointer ,var '(:struct VkRect2D) '%vk::extent))) 139 | (with-foreign-slots ((%vk::x %vk::y) ,p-offset-sym (:struct VkOffset2D)) 140 | (with-foreign-slots ((%vk::width %vk::height) ,p-extent-sym (:struct VkExtent2D)) 141 | (setf %vk::x (round ,x-sym) 142 | %vk::y (round ,y-sym) 143 | %vk::width (round ,width-sym) 144 | %vk::height (round ,height-sym)) 145 | ,@body))))))) 146 | -------------------------------------------------------------------------------- /src/memory-heap.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun memory-heap-device-local-p (memory-heap) 25 | (logtest (memory-heap-flags memory-heap) VK_MEMORY_HEAP_DEVICE_LOCAL_BIT)) 26 | 27 | (defconstant VK_MEMORY_HEAP_MULTI_INSTANCE_BIT 2) 28 | 29 | (defun memory-heap-multi-instance-p (memory-heap) 30 | (logtest (memory-heap-flags memory-heap) VK_MEMORY_HEAP_MULTI_INSTANCE_BIT)) 31 | 32 | (defun get-memory-heap-count (gpu) 33 | (with-foreign-object (p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties)) 34 | (vkGetPhysicalDeviceMemoryProperties (h gpu) p-memory-properties) 35 | (foreign-slot-value p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeapCount))) 36 | 37 | (defun %get-memory-heaps (gpu-handle) 38 | (with-foreign-object (p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties)) 39 | (vkGetPhysicalDeviceMemoryProperties gpu-handle p-memory-properties) 40 | (loop for i from 0 below (foreign-slot-value p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeapCount) 41 | collect (let ((p-memory-heap (mem-aptr (foreign-slot-pointer p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeaps) 42 | '(:struct VkMemoryHeap) 43 | i))) 44 | (make-instance 'memory-heap 45 | :flags (foreign-slot-value p-memory-heap '(:struct VkMemoryHeap) '%vk::flags) 46 | :size (foreign-slot-value p-memory-heap '(:struct VkMemoryHeap) '%vk::size)))))) 47 | 48 | 49 | (defun get-memory-heap-size (gpu heap-index) 50 | (with-foreign-object (p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties)) 51 | (vkGetPhysicalDeviceMemoryProperties (h gpu) p-memory-properties) 52 | (when (< heap-index (foreign-slot-value p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeapCount)) 53 | (let ((p-memory-heap (mem-aptr (foreign-slot-pointer p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeaps) 54 | '(:struct VkMemoryHeap) 55 | heap-index))) 56 | (foreign-slot-value p-memory-heap '(:struct VkMemoryHeap) '%vk::size))))) 57 | 58 | (defun get-memory-heap-flags (gpu heap-index) 59 | (with-foreign-object (p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties)) 60 | (vkGetPhysicalDeviceMemoryProperties (h gpu) p-memory-properties) 61 | (when (< heap-index (foreign-slot-value p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeapCount)) 62 | (let ((p-memory-heap (mem-aptr (foreign-slot-pointer p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryHeaps) 63 | '(:struct VkMemoryHeap) 64 | heap-index))) 65 | (foreign-slot-value p-memory-heap '(:struct VkMemoryHeap) '%vk::flags))))) 66 | 67 | 68 | -------------------------------------------------------------------------------- /src/memory-type.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | 25 | 26 | (defun %memory-type-property-flags (p-memory-type) 27 | (foreign-slot-value p-memory-type '(:struct VkMemoryType) '%vk::propertyFlags)) 28 | 29 | (defun %memory-type-heap-index (p-memory-type) 30 | (foreign-slot-value p-memory-type '(:struct VkMemoryType) '%vk::heapIndex)) 31 | 32 | (defun %get-memory-types (gpu-handle) 33 | (with-foreign-object (p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties)) 34 | (vkGetPhysicalDeviceMemoryProperties gpu-handle p-memory-properties) 35 | (loop for i from 0 below (foreign-slot-value p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryTypeCount) 36 | collect (let ((p-memory-type (mem-aptr (foreign-slot-pointer p-memory-properties '(:struct VkPhysicalDeviceMemoryProperties) '%vk::memoryTypes) 37 | '(:struct VkMemoryType) 38 | i))) 39 | (make-instance 'memory-type 40 | :property-flags (%memory-type-property-flags p-memory-type) 41 | :heap-index (%memory-type-heap-index p-memory-type)))))) 42 | 43 | (defun memory-type-device-local-p (memory-type) 44 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT)) 45 | 46 | (defun memory-type-host-visible-p (memory-type) 47 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT)) 48 | 49 | (defun memory-type-host-coherent-p (memory-type) 50 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_HOST_COHERENT_BIT)) 51 | 52 | (defun memory-type-host-cached-p (memory-type) 53 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_HOST_CACHED_BIT)) 54 | 55 | (defun memory-type-lazily-allocated-p (memory-type) 56 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT)) 57 | 58 | (defconstant VK_MEMORY_PROPERTY_PROTECTED_BIT #x20) 59 | 60 | (defun memory-type-protected-p (memory-type) 61 | (logtest (memory-type-property-flags memory-type) VK_MEMORY_PROPERTY_PROTECTED_BIT)) 62 | 63 | (defun find-memory-type (gpu type-bits properties) 64 | (loop for memory-type in (memory-types gpu) 65 | for i from 0 66 | when (and (logtest type-bits (ash 1 i)) 67 | (= (logand (memory-type-property-flags memory-type) properties) properties)) 68 | do (return i) 69 | finally (error "Could not find suitable memory type!"))) 70 | 71 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :cl-user) 23 | 24 | (cl:defpackage :vk 25 | (:use :cl :cffi :cffi-sys :%vk #+glfw :$glfw) 26 | 27 | #-glfw(:import-from :clui #:h #:handle-mixin #:handle) 28 | 29 | (:export #:vulkan-enabled-display-mixin 30 | #:VK_WHOLE_SIZE 31 | #:allocation-callbacks 32 | #:pipeline-cache 33 | #:*vulkan-instance* 34 | #:vulkan-window-mixin 35 | #:vulkan-window 36 | #:destroy-vulkan-instance 37 | #:free-command-buffers 38 | #:sgpu-device 39 | #:mgpu-device 40 | #:swapchain 41 | #:+nullptr+ 42 | #:+null-allocator+ 43 | #:+null-pipeline-cache+ 44 | #:+null-swapchain+ 45 | #:+null-descriptor-set-layout+ 46 | #:vulkan-application-mixin 47 | #:frame-resources 48 | #:debug-report-callback 49 | #:surface-format 50 | #:surface 51 | #:physical-device-features 52 | #:physical-device-limits 53 | #:physical-device 54 | #:queue-family 55 | #:extent-3D 56 | #:memory-type 57 | #:memory-heap 58 | #:surface-capabilities 59 | #:extent-2D 60 | #:dedicated-queue 61 | #:multipurpose-queue 62 | ;;#:image 63 | #:depth-image 64 | #:image-view 65 | #:render-pass 66 | #:color-attachment 67 | #:depth-attachment 68 | #:subpass 69 | #:descriptor-set-layout-binding 70 | #:uniform-buffer-for-vertex-shader-dsl-binding 71 | #:storage-buffer-for-fragment-shader-dsl-binding 72 | #:uniform-buffer-for-geometry-shader-dsl-binding 73 | #:sample-uniform-buffer-for-compute-shader-dsl-binding 74 | #:sample-input-storage-buffer-for-compute-shader-dsl-binding 75 | #:descriptor-set-layout 76 | #:null-descriptor-set-layout 77 | #:push-constant-range 78 | #:pipeline-layout 79 | #:shader-module 80 | #:pipeline 81 | #:compute-pipeline 82 | #:graphics-pipeline 83 | #:vertex-input-attribute-description 84 | #:compute-pipeline-create-info 85 | #:shader-stage-create-info 86 | #:command-pool 87 | #:framebuffer 88 | #:vertex-buffer 89 | #:index-buffer 90 | #:allocated-memory 91 | #:uniform-buffer 92 | #:descriptor-pool 93 | #:descriptor-set 94 | #:descriptor-buffer-info 95 | #:descriptor-uniform-buffer-info 96 | #:descriptor-storage-buffer-info 97 | #:command-buffer 98 | #:sampler 99 | #:draw-index-cmd 100 | #:acquire-memory-sized 101 | #:release-memory 102 | 103 | #:with-fences 104 | #:create-buffer-1 105 | #:destroy-buffer 106 | #:allocate-buffer-memory 107 | #:bind-buffer-memory 108 | #:copy-buffer 109 | #:create-empty-buffer 110 | #:create-buffer 111 | #:create-vertex-buffer 112 | #:create-index-buffer 113 | #:create-uniform-buffer 114 | #:copy-uniform-buffer-memory 115 | #:create-command-buffer 116 | #:create-command-buffer-1 117 | #:free-command-buffers 118 | #:free-command-buffer 119 | #:begin-command-buffer 120 | #:cmd-set-viewport 121 | #:cmd-set-scissor 122 | #:cmd-bind-pipeline 123 | #:cmd-bind-vertex-buffers 124 | #:cmd-bind-descriptor-sets 125 | #:cmd-bind-index-buffer 126 | #:cmd-draw-indexed 127 | #:create-command-pool 128 | #:find-command-pool 129 | #:destroy-command-pool 130 | #:reset-command-pool 131 | #:create-compute-pipeline 132 | #:debug-report-function 133 | #:create-debug-report-callback 134 | #:destroy-debug-report-callback 135 | #:create-descriptor-pool 136 | #:create-descriptor-pool-1 137 | #:create-descriptor-set-layout 138 | #:destroy-descriptor-set-layout 139 | #:allocate-descriptor-set 140 | #:create-descriptor-set 141 | #:set-framebuffer-size-callback 142 | #:create-framebuffer 143 | #:setup-framebuffers 144 | #:resize-framebuffer 145 | #:destroy-framebuffers 146 | #:destroy-framebuffer 147 | #:create-graphics-pipeline 148 | #:destroy-pipeline 149 | #:get-swapchain-images-khr 150 | #:create-image 151 | #:create-depth-image 152 | #:destroy-image 153 | #:transition-image-layout 154 | #:create-image-view 155 | #:create-depth-image-view 156 | #:create-image-views 157 | #:destroy-image-view 158 | #:create-logical-device 159 | #:begin-single-time-commands 160 | #:end-single-time-commands 161 | #:device-wait-idle 162 | #:memory-heap-device-local-p 163 | #:memory-heap-multi-instance-p 164 | #:find-memory-type 165 | #:memory-type-device-local-p 166 | #:memory-type-host-visible-p 167 | #:memory-type-host-coherent-p 168 | #:memory-type-host-cached-p 169 | #:memory-type-lazily-allocated-p 170 | #:memory-type-protected-p 171 | #:get-queue-family-index-with-dedicated-compute-support 172 | #:get-any-queue-family-index-with-compute-support 173 | #:get-queue-family-index-with-dedicated-transfer-support 174 | #:get-any-queue-family-index-with-transfer-support 175 | #:get-physical-device-memory-properties 176 | #:get-physical-device-queue-family-properties 177 | #:enumerate-physical-devices 178 | #:create-pipeline-layout 179 | #:destroy-pipeline-layout 180 | #:get-present-modes 181 | #:graphics-queue-family-p 182 | #:compute-queue-family-p 183 | #:transfer-queue-family-p 184 | #:sparse-binding-queue-family-p 185 | #:min-image-transfer-granularity-width 186 | #:min-image-transfer-granularity-height 187 | #:min-image-transfer-granularity-depth 188 | #:get-device-queue 189 | #:find-queue 190 | #:compute-queue 191 | #:queue-wait-idle 192 | #:queue-submit1 193 | #:queue-submit 194 | #:create-render-pass 195 | #:destroy-render-pass 196 | #:create-sampler 197 | #:create-shader-module-from-file 198 | #:read-shader-file 199 | #:create-shader-module 200 | #:destroy-shader-module 201 | #:capabilities-current-extent-width 202 | #:capabilities-current-extent-height 203 | #:get-physical-device-surface-capabilities-khr 204 | #:get-surface-formats 205 | #:find-supported-depth-format 206 | #:find-supported-format 207 | #:has-stencil-component-p 208 | #:get-queue-family-index-with-wsi-support 209 | #:supports-presentation-mode-p 210 | #:create-window-surface 211 | #:initialize-window-surface 212 | #:pick-graphics-gpu 213 | #:create-frame-resources 214 | #:destroy-frame-resources 215 | #:create-swapchain 216 | #:initialize-swapchain 217 | #:destroy-swapchain-resources 218 | #:recreate-swapchain 219 | #:destroy-swapchain 220 | #:frame-begin 221 | #:frame-end 222 | #:frame-present 223 | #:setup-vulkan 224 | #:available-layers 225 | #:available-extensions 226 | #:create-instance 227 | #:error-callback-function 228 | #:set-window-close-callback 229 | ;;#:find-window 230 | #:default-application-class-for-window 231 | #:default-window-class-for-application 232 | #:create-vulkan-window 233 | #:default-logical-device 234 | #:main-window 235 | #:queue-family-index 236 | #:render-surface 237 | #:command-buffers 238 | #:end-command-buffer 239 | #:main 240 | #:h 241 | #:recreate-swapchain? 242 | #:frame-command-buffer 243 | #:clear-value 244 | #:number-of-images 245 | #:default-descriptor-pool 246 | #:frame-resource 247 | #:check-vk-result 248 | #:allocator 249 | #:mmap-buffer 250 | #:window-frame-data 251 | #:window-registry 252 | #:vulkan-module 253 | #:vulkan-instance 254 | #:current-frame 255 | #:image-index 256 | 257 | #:with-vertex-input-binding-description 258 | #:with-pipeline-vertex-input-state-create-info 259 | #:with-pipeline-input-assembly-state-create-info 260 | #:with-viewport-structure 261 | #:with-scissor-structure 262 | #:with-pipeline-viewport-state-create-info 263 | #:with-pipeline-rasterization-state-create-info 264 | #:with-pipeline-rasterization-line-state-create-info-ext 265 | #:with-pipeline-multisample-state-create-info 266 | #:with-graphics-pipeline-create-info 267 | #:with-pipeline-depth-stencil-state-create-info 268 | #:with-descriptor-set-layouts 269 | #:with-pipeline-layout-create-info 270 | #:with-pipeline-dynamic-state-create-info 271 | #:with-dynamic-states 272 | #:with-pipeline-color-blend-state-create-info 273 | #:api-version 274 | #:with-viewport 275 | #:with-scissor 276 | 277 | #:clampf 278 | 279 | #:+buffer-alignment+ 280 | #:aligned-size)) 281 | -------------------------------------------------------------------------------- /src/pipeline-cache.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | 25 | -------------------------------------------------------------------------------- /src/pipeline-layout.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-pipeline-layout (device descriptor-set-layouts &key (allocator +null-allocator+) 25 | (push-constant-ranges nil)) 26 | (with-pipeline-layout-create-info (p-create-info) 27 | (let ((dsl-count (length descriptor-set-layouts)) 28 | (push-constant-range-count (length push-constant-ranges))) 29 | (with-foreign-object (p-set-layouts 'VkDescriptorSetLayout dsl-count) 30 | (loop for dsl in descriptor-set-layouts for i from 0 31 | do (setf (mem-aref p-set-layouts 'VkDescriptorSetLayout i) (h dsl))) 32 | (with-foreign-object (p-push-constant-ranges '(:struct VkPushConstantRange) push-constant-range-count) 33 | (loop for pcr in push-constant-ranges for i from 0 34 | do (with-foreign-slots ((%vk::stageFlags 35 | %vk::offset 36 | %vk::size) 37 | (mem-aptr p-push-constant-ranges '(:struct VkPushConstantRange) i) 38 | (:struct VkPushConstantRange)) 39 | (setf %vk::stageFlags (push-constant-range-stage-flags pcr) 40 | %vk::offset (push-constant-range-offset pcr) 41 | %vk::size (push-constant-range-size pcr)))) 42 | (with-foreign-slots ((%vk::sType 43 | %vk::pNext 44 | %vk::setLayoutCount 45 | %vk::pSetLayouts 46 | %vk::pushConstantRangeCount 47 | %vk::pPushConstantRanges) 48 | p-create-info 49 | (:struct VkPipelineLayoutCreateInfo)) 50 | (setf %vk::sType VK_STRUCTURE_TYPE_PIPELINE_LAYOUT_CREATE_INFO 51 | %vk::pNext +nullptr+ 52 | %vk::setLayoutCount dsl-count 53 | %vk::pSetLayouts p-set-layouts 54 | %vk::pushConstantRangeCount push-constant-range-count 55 | %vk::pPushConstantRanges (if push-constant-ranges p-push-constant-ranges +nullptr+))) 56 | (with-foreign-object (p-pipeline-layout 'VkPipelineLayout) 57 | (vkCreatePipelineLayout (h device) p-create-info (h allocator) p-pipeline-layout) 58 | (let ((pipeline-layout 59 | (make-instance 'pipeline-layout :handle (mem-aref p-pipeline-layout 'VkPipelineLayout) 60 | :device device :allocator allocator))) 61 | (loop for dsl in descriptor-set-layouts 62 | do (vector-push-extend dsl (descriptor-set-layouts pipeline-layout))) 63 | pipeline-layout))))))) 64 | 65 | (defun destroy-pipeline-layout (pipeline-layout) 66 | (with-slots (device allocator) pipeline-layout 67 | (vkDestroyPipelineLayout (h device) (h pipeline-layout) (h allocator))) 68 | (values)) 69 | -------------------------------------------------------------------------------- /src/present-modes.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defvar *present-mode*) 25 | 26 | (defun get-present-modes (gpu surface) 27 | (with-foreign-object (p-count :uint32) 28 | (check-vk-result (vkGetPhysicalDeviceSurfacePresentModesKHR (h gpu) (h surface) p-count +nullptr+)) 29 | (let ((count (mem-aref p-count :uint32))) 30 | (with-foreign-object (p-present-modes 'VkPresentModeKHR count) 31 | (check-vk-result (vkGetPhysicalDeviceSurfacePresentModesKHR (h gpu) (h surface) p-count p-present-modes)) 32 | (loop for i from 0 below (mem-aref p-count :uint32) 33 | collect (mem-aref p-present-modes 'VkPresentModeKHR i)))))) 34 | 35 | (defun get-physical-device-surface-present-mode (gpu surface) 36 | (setq *present-mode* 37 | (let ((present-modes (get-present-modes gpu surface))) 38 | (if (find VK_PRESENT_MODE_FIFO_RELAXED_KHR present-modes) 39 | VK_PRESENT_MODE_FIFO_RELAXED_KHR 40 | (if (find VK_PRESENT_MODE_FIFO_KHR present-modes) 41 | VK_PRESENT_MODE_FIFO_KHR 42 | (if (member VK_PRESENT_MODE_MAILBOX_KHR present-modes) 43 | VK_PRESENT_MODE_MAILBOX_KHR 44 | (if (find VK_PRESENT_MODE_IMMEDIATE_khr present-modes) 45 | VK_PRESENT_MODE_IMMEDIATE_KHR 46 | (error "could not find a present mode for surface")))))))) 47 | -------------------------------------------------------------------------------- /src/queue-family.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defmethod graphics-queue-family-p ((queue-family queue-family)) 25 | (not (zerop (logand (queue-flags queue-family) VK_QUEUE_GRAPHICS_BIT)))) 26 | 27 | (defmethod compute-queue-family-p ((queue-family queue-family)) 28 | (not (zerop (logand (queue-flags queue-family) VK_QUEUE_COMPUTE_BIT)))) 29 | 30 | (defmethod transfer-queue-family-p ((queue-family queue-family)) 31 | (not (zerop (logand (queue-flags queue-family) VK_QUEUE_TRANSFER_BIT)))) 32 | 33 | (defmethod sparse-binding-queue-family-p ((queue-family queue-family)) 34 | (not (zerop (logand (queue-flags queue-family) VK_QUEUE_SPARSE_BINDING_BIT)))) 35 | 36 | (defmethod min-image-transfer-granularity-width ((queue-family queue-family)) 37 | (extent-3D-width (slot-value queue-family 'min-image-transfer-granularity))) 38 | 39 | (defmethod min-image-transfer-granularity-height ((queue-family queue-family)) 40 | (extent-3D-height (slot-value queue-family 'min-image-transfer-granularity))) 41 | 42 | (defmethod min-image-transfer-granularity-depth ((queue-family queue-family)) 43 | (extent-3D-depth (slot-value queue-family 'min-image-transfer-granularity))) 44 | -------------------------------------------------------------------------------- /src/queue.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun queue-family (queue) 25 | (nth (queue-family-index queue) (queue-families (physical-device (device queue))))) 26 | 27 | (defun find-queue (device queue-family-index) 28 | (let ((entry (assoc queue-family-index (device-queues device)))) 29 | (if entry 30 | (first (second entry)) 31 | (error "Could not find device queue fo device ~S of queue-family-index ~A" device queue-family-index)))) 32 | 33 | (defun queue-wait-idle (queue) 34 | (check-vk-result (vkQueueWaitIdle (h queue)))) 35 | 36 | (defun queue-submit1 (queue command-buffer) 37 | (with-foreign-objects ((p-command-buffer 'VkCommandBuffer)) 38 | (setf (mem-aref p-command-buffer 'VkCommandBuffer) (h command-buffer)) 39 | (with-vk-struct (p-end-info VkSubmitInfo) 40 | (with-foreign-slots ((%vk::commandBufferCount %vk::pCommandBuffers) 41 | p-end-info (:struct VkSubmitInfo)) 42 | (setf %vk::commandBufferCount 1 43 | %vk::pCommandBuffers p-command-buffer) 44 | 45 | (check-vk-result (vkQueueSubmit (h queue) 1 p-end-info VK_NULL_HANDLE)))))) 46 | 47 | (defun queue-submit (queue command-buffer wait-semaphore signal-semaphore fence 48 | &optional (wait-stage-mask VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT)) 49 | (with-foreign-object (p-command-buffer 'VkCommandBuffer) 50 | (setf (mem-aref p-command-buffer 'VkCommandBuffer) (h command-buffer)) 51 | (with-foreign-object (p-wait-semaphore 'VkSemaphore) 52 | (setf (mem-aref p-wait-semaphore 'VkSemaphore) (h wait-semaphore)) 53 | (with-foreign-object (p-signal-semaphore 'VkSemaphore) 54 | (setf (mem-aref p-signal-semaphore 'VkSemaphore) (h signal-semaphore)) 55 | (with-vk-struct (p-submit-info VkSubmitInfo) 56 | (with-foreign-object (p-wait-stage 'VkPipelineStageFlags) 57 | (setf (mem-aref p-wait-stage 'VkPipelineStageFlags) wait-stage-mask) 58 | (with-foreign-slots ((%vk::commandBufferCount 59 | %vk::pCommandBuffers 60 | %vk::waitSemaphoreCount 61 | %vk::pWaitSemaphores 62 | %vk::pWaitDstStageMask 63 | %vk::signalSemaphoreCount 64 | %vk::pSignalSemaphores) 65 | p-submit-info (:struct VkSubmitInfo)) 66 | (setf %vk::commandBufferCount 1 67 | %vk::pCommandBuffers p-command-buffer 68 | %vk::waitSemaphoreCount 1 69 | %vk::pWaitSemaphores p-wait-semaphore 70 | %vk::pWaitDstStageMask p-wait-stage 71 | %vk::signalSemaphoreCount 1 72 | %vk::pSignalSemaphores p-signal-semaphore) 73 | 74 | (check-vk-result 75 | (vkQueueSubmit (h queue) 1 p-submit-info (h fence)))))))))) 76 | -------------------------------------------------------------------------------- /src/render-pass.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-render-pass (device format-enum &key (allocator +null-allocator+) 25 | 26 | (color-attachments (list (make-instance 'color-attachment 27 | :name :default-color-attachment 28 | :samples VK_SAMPLE_COUNT_4_BIT 29 | :format format-enum 30 | :final-layout VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL) 31 | )) 32 | (multisample-attachment (make-instance 'color-attachment 33 | :name :multisample-attachment 34 | :format format-enum 35 | :samples VK_SAMPLE_COUNT_1_BIT 36 | :load-op VK_ATTACHMENT_LOAD_OP_DONT_CARE)) 37 | (depth-attachments (list (make-instance 'depth-attachment 38 | :name :default-depth-stencil-attachment 39 | 40 | :samples VK_SAMPLE_COUNT_4_BIT 41 | :format (find-supported-depth-format (physical-device device))) 42 | (make-instance 'depth-attachment 43 | :name :default-depth-stencil-attachment 44 | 45 | :samples VK_SAMPLE_COUNT_4_BIT 46 | :format (find-supported-depth-format (physical-device device))))) 47 | (subpasses (list (make-instance 'subpass 48 | :name :default-subpass 49 | :color-attachments (list :default-color-attachment) 50 | :depth-attachments (list :default-depth-stencil-attachment)))) 51 | (subpass-dependencies nil)) 52 | 53 | (let ((attachment-count (+ (length color-attachments) (length depth-attachments) 1)) 54 | (pointers ())) 55 | (with-foreign-object (p-attachments '(:struct VkAttachmentDescription) attachment-count) ;; todo: make with-vk-struct take a count. Long overdue. 56 | (loop for i from 0 for attachment in (append color-attachments depth-attachments (list multisample-attachment)) 57 | do (zero-struct (mem-aptr p-attachments '(:struct VkAttachmentDescription) i) '(:struct VkAttachmentDescription)) 58 | (with-foreign-slots ((%vk::format 59 | %vk::samples 60 | %vk::loadOp 61 | %vk::storeOp 62 | %vk::stencilLoadOp 63 | %vk::stencilStoreOp 64 | %vk::initialLayout 65 | %vk::finalLayout) 66 | (mem-aptr p-attachments '(:struct VkAttachmentDescription) i) (:struct VkAttachmentDescription)) 67 | (setf %vk::format (attachment-format attachment) 68 | %vk::samples (samples attachment) 69 | %vk::loadOp (load-op attachment) 70 | %vk::storeOp (store-op attachment) 71 | %vk::stencilLoadOp (stencil-load-op attachment) 72 | %vk::stencilStoreOp (stencil-store-op attachment) 73 | %vk::initialLayout (initial-layout attachment) 74 | %vk::finalLayout (final-layout attachment)))) 75 | 76 | (let ((subpass-count (length subpasses)) 77 | (dependency-count (length subpass-dependencies))) 78 | 79 | (unwind-protect 80 | (with-foreign-object (p-subpasses '(:struct VkSubpassDescription) subpass-count) 81 | (loop for i from 0 for subpass in subpasses 82 | do (zero-struct (mem-aptr p-subpasses '(:struct VkSubpassDescription) i) '(:struct VkSubpassDescription)) 83 | 84 | (with-foreign-slots ((%vk::pipelineBindPoint 85 | %vk::colorAttachmentCount 86 | %vk::pColorAttachments 87 | %vk::pResolveAttachments 88 | 89 | %vk::pDepthStencilAttachment) 90 | (mem-aptr p-subpasses '(:struct VkSubpassDescription) i) 91 | (:struct VkSubpassDescription)) 92 | (let* ((color-attachment-references (color-attachments subpass)) 93 | (color-reference-count (length color-attachment-references))) 94 | (let ((p-attachment-refs (foreign-alloc '(:struct VkAttachmentReference) :count color-reference-count)) 95 | (p-resolve-attachment (foreign-alloc '(:struct VkAttachmentReference)))) 96 | (push p-attachment-refs pointers) 97 | (push p-resolve-attachment pointers) 98 | (%vk::zero-struct p-resolve-attachment '(:struct VkAttachmentReference)) 99 | (with-foreign-slots ((%vk::attachment %vk::layout) 100 | p-resolve-attachment 101 | (:struct VkAttachmentReference)) 102 | (setf %vk::attachment 3 103 | %vk::layout VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL)) 104 | 105 | (loop for reference in color-attachment-references for i from 0 106 | do (%vk::zero-struct (mem-aptr p-attachment-refs '(:struct VkAttachmentReference) i) '(:struct VkAttachmentReference)) 107 | (with-foreign-slots ((%vk::attachment %vk::layout) 108 | (mem-aptr p-attachment-refs '(:struct VkAttachmentReference) i) 109 | (:struct VkAttachmentReference)) 110 | (setf %vk::attachment (position reference color-attachments :key #'attachment-name) 111 | %vk::layout (reference-layout (find reference color-attachments :key #'attachment-name))))) 112 | (let* ((depth-attachment-references (depth-attachments subpass)) 113 | (depth-reference-count (length depth-attachment-references)) 114 | (p-depth-attachment-refs (foreign-alloc '(:struct VkAttachmentReference) :count depth-reference-count))) 115 | (push p-depth-attachment-refs pointers) 116 | (loop for reference in depth-attachment-references 117 | do (let ((p-depth-attachment-ref (mem-aptr p-depth-attachment-refs '(:struct VkAttachmentReference) i))) 118 | (zero-struct p-depth-attachment-ref '(:struct VkAttachmentReference)) 119 | (with-foreign-slots ((%vk::attachment %vk::layout) 120 | p-depth-attachment-ref 121 | (:struct VkAttachmentReference)) 122 | (setf %vk::attachment (+ (length color-attachments) (position reference depth-attachments :key #'attachment-name)) 123 | %vk::layout (reference-layout (find reference depth-attachments :key #'attachment-name)))) 124 | 125 | (setf %vk::pipelineBindPoint (pipeline-bind-point subpass) 126 | %vk::colorAttachmentCount color-reference-count 127 | %vk::pColorAttachments p-attachment-refs 128 | %vk::pResolveAttachments p-resolve-attachment 129 | %vk::pDepthStencilAttachment p-depth-attachment-ref)))))))) 130 | 131 | (with-foreign-object (p-dependencies '(:struct VkSubpassDependency) dependency-count) 132 | (loop for i from 0 for dependency in subpass-dependencies 133 | do (zero-struct (mem-aptr p-dependencies '(:struct VkSubpassDependency) i) '(:struct VkSubpassDependency)) 134 | (with-foreign-slots ((%vk::srcSubpass 135 | %vk::dstSubpass 136 | %vk::srcAccessMask 137 | %vk::srcStageMask 138 | %vk::dstStageMask 139 | %vk::dstAccessMask) 140 | (mem-aptr p-dependencies '(:struct VkSubpassDependency) i) 141 | (:struct VkSubpassDependency)) 142 | 143 | (setf %vk::srcSubpass (src-subpass dependency) 144 | %vk::dstSubpass (dst-subpass dependency) 145 | %vk::srcAccessMask (src-access-mask dependency) 146 | %vk::srcStageMask (src-stage-mask dependency) 147 | ;;(logior VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) 148 | %vk::dstStageMask (dst-stage-mask dependency) 149 | ;;(logior VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) 150 | %vk::dstAccessMask (dst-access-mask dependency) 151 | ;;(logior VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT)) 152 | ))) 153 | 154 | 155 | (with-vk-struct (p-info VkRenderPassCreateInfo) 156 | (with-foreign-slots ((%vk::attachmentCount 157 | %vk::pAttachments 158 | %vk::subpassCount 159 | %vk::pSubpasses 160 | %vk::dependencyCount 161 | %vk::pDependencies) 162 | p-info (:struct VkRenderPassCreateInfo)) 163 | (setf %vk::attachmentCount attachment-count 164 | %vk::pAttachments p-attachments 165 | %vk::subpassCount subpass-count 166 | %vk::pSubpasses p-subpasses 167 | %vk::dependencyCount dependency-count 168 | %vk::pDependencies p-dependencies)) 169 | 170 | (with-foreign-object (p-render-pass 'VkRenderPass) 171 | (check-vk-result (vkCreateRenderPass (h device) p-info (h allocator) p-render-pass)) 172 | (make-instance 'render-pass :handle (mem-aref p-render-pass 'VkRenderPass) 173 | :device device :allocator allocator))))) 174 | (mapcar #'foreign-free pointers)))))) 175 | 176 | (defun destroy-render-pass (render-pass) 177 | (with-slots (device) render-pass 178 | (with-slots (allocator) device 179 | (vkDestroyRenderPass (h device) (h render-pass) (h allocator)))) 180 | (values)) 181 | -------------------------------------------------------------------------------- /src/sampler.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-sampler (device &key (allocator +null-allocator+)) 25 | (with-vk-struct (p-info VkSamplerCreateInfo) 26 | (with-foreign-slots ((%vk::magFilter 27 | %vk::minFilter 28 | %vk::mipmapMode 29 | %vk::addressModeU 30 | %vk::addressModeV 31 | %vk::addressModeW 32 | %vk::minLod 33 | %vk::maxLod 34 | %vk::maxAnisotropy) 35 | p-info 36 | (:struct VkSamplerCreateInfo)) 37 | (setf %vk::magFilter VK_FILTER_LINEAR 38 | %vk::minFilter VK_FILTER_LINEAR 39 | %vk::mipmapMode VK_SAMPLER_MIPMAP_MODE_LINEAR 40 | %vk::addressModeU VK_SAMPLER_ADDRESS_MODE_REPEAT 41 | %vk::addressModeV VK_SAMPLER_ADDRESS_MODE_REPEAT 42 | %vk::addressModeW VK_SAMPLER_ADDRESS_MODE_REPEAT 43 | %vk::minLod -1000.0f0 44 | %vk::maxLod 1000.0f0 45 | %vk::maxAnisotropy 1.0f0) 46 | (with-foreign-object (p-sampler 'VkSampler) 47 | (check-vk-result (vkCreateSampler (h device) p-info (h allocator) p-sampler)) 48 | (make-instance 'sampler 49 | :handle (mem-aref p-sampler 'VkSampler) 50 | :device device))))) 51 | -------------------------------------------------------------------------------- /src/shader-module.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun create-shader-module-from-file (device filename &key (allocator +null-allocator+)) 25 | (multiple-value-bind (binary size) (read-shader-file filename) 26 | (unwind-protect (create-shader-module device binary size :allocator allocator) 27 | (foreign-free binary)))) 28 | 29 | (defun read-shader-file (filename) 30 | (with-open-file (stream filename :element-type '(unsigned-byte 8)) 31 | (let ((buffer (make-array 1024 :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)) 32 | (byte)) 33 | (loop while (setq byte (read-byte stream nil)) 34 | do (vector-push-extend byte buffer)) 35 | (let* ((size (fill-pointer buffer)) 36 | (binary (foreign-alloc (list :array :unsigned-char size)))) 37 | (loop for b across buffer for i from 0 38 | do (setf (mem-aref binary :unsigned-char i) b)) 39 | (values binary size))))) 40 | 41 | (defun create-shader-module (device p-code size &key (allocator +null-allocator+)) 42 | (with-vk-struct (p-create-info VkShaderModuleCreateInfo) 43 | (with-foreign-slots ((%vk::codeSize 44 | %vk::pCode) 45 | p-create-info 46 | (:struct VkShaderModuleCreateInfo)) 47 | (setf %vk::codeSize size 48 | %vk::pCode p-code) 49 | (with-foreign-object (p-shader-module 'VkShaderModule) 50 | (check-vk-result (vkCreateShaderModule (h device) p-create-info (h allocator) p-shader-module)) 51 | (make-instance 'shader-module :handle (mem-aref p-shader-module 'VkShaderModule) 52 | :device device :allocator allocator))))) 53 | 54 | (defun destroy-shader-module (shader-module) 55 | (let ((device (device shader-module)) 56 | (allocator (allocator shader-module))) 57 | (vkDestroyShaderModule (h device) (h shader-module) (h allocator)) 58 | (values))) 59 | -------------------------------------------------------------------------------- /src/spirv.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (cffi:defcfun ("compile_to_spv" compile_to_spv) :int 25 | (kind :int) 26 | (program :string) 27 | (bytes :pointer) 28 | (length :pointer)) 29 | 30 | (defstruct spirv 31 | (code) 32 | (length)) 33 | 34 | (defun compile-to-spirv (program &key (kind :vertex-shader)) 35 | (let ((enum-kind (ecase kind 36 | (:vertex-shader 0) 37 | (:fragment-shader 1)))) 38 | (with-foreign-objects ((pp-bytes :pointer) 39 | (p-length :int64)) 40 | (when (zerop (compile_to_spv enum-kind program pp-bytes p-length)) 41 | (make-spirv :code (cffi:mem-aref pp-bytes :pointer) 42 | :length (cffi:mem-aref p-length :int64)))))) 43 | -------------------------------------------------------------------------------- /src/support.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (cffi:defcfun ("memcpy" memcpy) :pointer 25 | (dest :pointer) 26 | (src :pointer) 27 | (count size-t)) 28 | 29 | (defcfun ("memset" memset) :pointer 30 | (str :pointer) (ch :int) (n size-t)) 31 | 32 | (%vk::defvkdevextfun ("vkCmdSetLineStippleEXT" vkCmdSetLineStippleEXT) :void 33 | (command-buffer VkCommandBuffer) 34 | (line-stipple-factor :unsigned-int) 35 | (line-stipple-pattern :unsigned-short)) 36 | 37 | (defvar *debug* (if (boundp 'cl-user::*debug*) (symbol-value 'cl-user::*debug*) 1)) 38 | 39 | (defconstant VK_UUID_SIZE 16) 40 | 41 | (defconstant +NULL+ 0) 42 | ;;(defconstant IMGUI_MAX_POSSIBLE_BACK_BUFFERS 16) 43 | (defconstant UINT64_MAX #.(1- (expt 2 64))) 44 | 45 | (defconstant VK_WHOLE_SIZE #.(1- (expt 2 64))) 46 | 47 | (defparameter +nullptr+ (cffi-sys:null-pointer)) 48 | 49 | (defparameter VK_NULL_HANDLE +nullptr+) 50 | ;;(defparameter *imgui-unlimited-frame-rate* nil) 51 | (defconstant VK_QUEUE_FAMILY_IGNORED 0) 52 | (defconstant VK_IMAGE_LAYOUT_UNDEFINED 0) 53 | (defconstant VK_SUBPASS_EXTERNAL 0) 54 | 55 | (defparameter VK_KHR_SURFACE_EXTENSION_NAME "VK_KHR_surface") 56 | (defparameter VK_KHR_SWAPCHAIN_EXTENSION_NAME "VK_KHR_swapchain") 57 | (defparameter VK_KHR_DISPLAY_EXTENSION_NAME "VK_KHR_display") 58 | (defparameter VK_KHR_DISPLAY_SWAPCHAIN_EXTENSION_NAME "VK_KHR_display_swapchain") 59 | (defparameter VK_KHR_XLIB_SURFACE_EXTENSION_NAME "VK_KHR_xlib_surface") 60 | (defparameter VK_KHR_XCB_SURFACE_EXTENSION_NAME "VK_KHR_xcb_surface") 61 | (defparameter VK_KHR_WAYLAND_SURFACE_EXTENSION_NAME "VK_KHR_wayland_surface") 62 | (defparameter VK_KHR_MIR_SURFACE_EXTENSION_NAME "VK_KHR_mir_surface") 63 | (defparameter VK_KHR_ANDROID_SURFACE_EXTENSION_NAME "VK_KHR_android_surface") 64 | (defparameter VK_KHR_WIN32_SURFACE_EXTENSION_NAME "VK_KHR_win32_surface") 65 | (defparameter VK_EXT_DEBUG_REPORT_EXTENSION_NAME "VK_EXT_debug_report") 66 | (defparameter VK_NV_GLSL_SHADER_EXTENSION_NAME "VK_NV_glsl_shader") 67 | (defparameter VK_NV_EXTENSION_1_EXTENSION_NAME "VK_NV_extension_1") 68 | (defparameter VK_KHR_SAMPLER_MIRROR_CLAMP_TO_EDGE_EXTENSION_NAME "VK_KHR_sampler_mirror_clamp_to_edge") 69 | (defparameter VK_IMG_FILTER_CUBIC_EXTENSION_NAME "VK_IMG_filter_cubic") 70 | (defparameter VK_AMD_EXTENSION_17_EXTENSION_NAME "VK_AMD_extension_17") 71 | (defparameter VK_AMD_EXTENSION_18_EXTENSION_NAME "VK_AMD_extension_18") 72 | (defparameter VK_AMD_RASTERIZATION_ORDER_EXTENSION_NAME "VK_AMD_rasterization_order") 73 | (defparameter VK_AMD_EXTENSION_20_EXTENSION_NAME "VK_AMD_extension_20") 74 | (defparameter VK_AMD_SHADER_TRINARY_MINMAX_EXTENSION_NAME "VK_AMD_shader_trinary_minmax") 75 | (defparameter VK_AMD_SHADER_EXPLICIT_VERTEX_PARAMETER_EXTENSION_NAME "VK_AMD_shader_explicit_vertex_parameter") 76 | (defparameter VK_EXT_DEBUG_MARKER_EXTENSION_NAME "VK_EXT_debug_marker") 77 | (defparameter VK_AMD_EXTENSION_24_EXTENSION_NAME "VK_AMD_extension_24") 78 | (defparameter VK_AMD_EXTENSION_25_EXTENSION_NAME "VK_AMD_extension_25") 79 | (defparameter VK_AMD_GCN_SHADER_EXTENSION_NAME "VK_AMD_gcn_shader") 80 | (defparameter VK_NV_DEDICATED_ALLOCATION_EXTENSION_NAME "VK_NV_dedicated_allocation") 81 | (defparameter VK_NV_EXTENSION_28_EXTENSION_NAME "VK_NV_extension_28") 82 | (defparameter VK_NVX_EXTENSION_29_EXTENSION_NAME "VK_NVX_extension_29") 83 | (defparameter VK_NVX_EXTENSION_30_EXTENSION_NAME "VK_NVX_extension_30") 84 | (defparameter VK_NVX_EXTENSION_31_EXTENSION_NAME "VK_NVX_extension_31") 85 | (defparameter VK_AMD_EXTENSION_32_EXTENSION_NAME "VK_AMD_extension_32") 86 | (defparameter VK_AMD_EXTENSION_33_EXTENSION_NAME "VK_AMD_extension_33") 87 | (defparameter VK_AMD_DRAW_INDIRECT_COUNT_EXTENSION_NAME "VK_AMD_draw_indirect_count") 88 | (defparameter VK_AMD_EXTENSION_35_EXTENSION_NAME "VK_AMD_extension_35") 89 | (defparameter VK_AMD_NEGATIVE_VIEWPORT_HEIGHT_EXTENSION_NAME "VK_AMD_negative_viewport_height") 90 | (defparameter VK_AMD_GPU_SHADER_HALF_FLOAT_EXTENSION_NAME "VK_AMD_gpu_shader_half_float") 91 | (defparameter VK_AMD_SHADER_BALLOT_EXTENSION_NAME "VK_AMD_shader_ballot") 92 | (defparameter VK_AMD_EXTENSION_39_EXTENSION_NAME "VK_AMD_extension_39") 93 | (defparameter VK_AMD_EXTENSION_40_EXTENSION_NAME "VK_AMD_extension_40") 94 | (defparameter VK_AMD_EXTENSION_41_EXTENSION_NAME "VK_AMD_extension_41") 95 | (defparameter VK_AMD_TEXTURE_GATHER_BIAS_LOD_EXTENSION_NAME "VK_AMD_texture_gather_bias_lod") 96 | (defparameter VK_AMD_EXTENSION_43_EXTENSION_NAME "VK_AMD_extension_43") 97 | (defparameter VK_AMD_EXTENSION_44_EXTENSION_NAME "VK_AMD_extension_44") 98 | (defparameter VK_AMD_EXTENSION_45_EXTENSION_NAME "VK_AMD_extension_45") 99 | (defparameter VK_AMD_EXTENSION_46_EXTENSION_NAME "VK_AMD_extension_46") 100 | (defparameter VK_AMD_EXTENSION_47_EXTENSION_NAME "VK_AMD_extension_47") 101 | (defparameter VK_NVX_EXTENSION_48_EXTENSION_NAME "VK_NVX_extension_48") 102 | (defparameter VK_GOOGLE_EXTENSION_49_EXTENSION_NAME "VK_GOOGLE_extension_49") 103 | (defparameter VK_GOOGLE_EXTENSION_50_EXTENSION_NAME "VK_GOOGLE_extension_50") 104 | (defparameter VK_NVX_EXTENSION_51_EXTENSION_NAME "VK_NVX_extension_51") 105 | (defparameter VK_NVX_EXTENSION_52_EXTENSION_NAME "VK_NVX_extension_52") 106 | (defparameter VK_NV_EXTENSION_53_EXTENSION_NAME "VK_NV_extension_53") 107 | (defparameter VK_KHX_MULTIVIEW_EXTENSION_NAME "VK_KHX_multiview") 108 | (defparameter VK_IMG_FORMAT_PVRTC_EXTENSION_NAME "VK_IMG_format_pvrtc") 109 | (defparameter VK_NV_EXTERNAL_MEMORY_CAPABILITIES_EXTENSION_NAME "VK_NV_external_memory_capabilities") 110 | (defparameter VK_NV_EXTERNAL_MEMORY_EXTENSION_NAME "VK_NV_external_memory") 111 | (defparameter VK_NV_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME "VK_NV_external_memory_win32") 112 | (defparameter VK_NV_WIN32_KEYED_MUTEX_EXTENSION_NAME "VK_NV_win32_keyed_mutex") 113 | (defparameter VK_KHR_GET_PHYSICAL_DEVICE_PROPERTIES2_EXTENSION_NAME "VK_KHR_get_physical_device_properties2") 114 | (defparameter VK_KHX_DEVICE_GROUP_EXTENSION_NAME "VK_KHX_device_group") 115 | (defparameter VK_EXT_VALIDATION_FLAGS_EXTENSION_NAME "VK_EXT_validation_flags") 116 | (defparameter VK_NN_VI_SURFACE_EXTENSION_NAME "VK_NN_vi_surface") 117 | (defparameter VK_KHR_SHADER_DRAW_PARAMETERS_EXTENSION_NAME "VK_KHR_shader_draw_parameters") 118 | (defparameter VK_EXT_SHADER_SUBGROUP_BALLOT_EXTENSION_NAME "VK_EXT_shader_subgroup_ballot") 119 | (defparameter VK_EXT_SHADER_SUBGROUP_VOTE_EXTENSION_NAME "VK_EXT_shader_subgroup_vote") 120 | (defparameter VK_ARM_EXTENSION_01_EXTENSION_NAME "VK_ARM_extension_01") 121 | (defparameter VK_ARM_EXTENSION_02_EXTENSION_NAME "VK_ARM_extension_02") 122 | (defparameter VK_IMG_EXTENSION_69_EXTENSION_NAME "VK_IMG_extension_69") 123 | (defparameter VK_KHR_MAINTENANCE1_EXTENSION_NAME "VK_KHR_maintenance1") 124 | (defparameter VK_KHX_DEVICE_GROUP_CREATION_EXTENSION_NAME "VK_KHX_device_group_creation") 125 | (defparameter VK_KHX_EXTERNAL_MEMORY_CAPABILITIES_EXTENSION_NAME "VK_KHX_external_memory_capabilities") 126 | (defparameter VK_KHX_EXTERNAL_MEMORY_EXTENSION_NAME "VK_KHX_external_memory") 127 | (defparameter VK_KHX_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME "VK_KHX_external_memory_win32") 128 | (defparameter VK_KHX_EXTERNAL_MEMORY_FD_EXTENSION_NAME "VK_KHX_external_memory_fd") 129 | (defparameter VK_KHX_WIN32_KEYED_MUTEX_EXTENSION_NAME "VK_KHX_win32_keyed_mutex") 130 | (defparameter VK_KHX_EXTERNAL_SEMAPHORE_CAPABILITIES_EXTENSION_NAME "VK_KHX_external_semaphore_capabilities") 131 | (defparameter VK_KHX_EXTERNAL_SEMAPHORE_EXTENSION_NAME "VK_KHX_external_semaphore") 132 | (defparameter VK_KHX_EXTERNAL_SEMAPHORE_WIN32_EXTENSION_NAME "VK_KHX_external_semaphore_win32") 133 | (defparameter VK_KHX_EXTERNAL_SEMAPHORE_FD_EXTENSION_NAME "VK_KHX_external_semaphore_fd") 134 | (defparameter VK_KHR_PUSH_DESCRIPTOR_EXTENSION_NAME "VK_KHR_push_descriptor") 135 | (defparameter VK_KHR_EXTENSION_82_EXTENSION_NAME "VK_KHR_extension_82") 136 | (defparameter VK_KHR_EXTENSION_83_EXTENSION_NAME "VK_KHR_extension_83") 137 | (defparameter VK_KHR_EXTENSION_84_EXTENSION_NAME "VK_KHR_extension_84") 138 | (defparameter VK_KHR_INCREMENTAL_PRESENT_EXTENSION_NAME "VK_KHR_incremental_present") 139 | (defparameter VK_KHR_DESCRIPTOR_UPDATE_TEMPLATE_EXTENSION_NAME "VK_KHR_descriptor_update_template") 140 | (defparameter VK_NVX_DEVICE_GENERATED_COMMANDS_EXTENSION_NAME "VK_NVX_device_generated_commands") 141 | (defparameter VK_NV_CLIP_SPACE_W_SCALING_EXTENSION_NAME "VK_NV_clip_space_w_scaling") 142 | (defparameter VK_EXT_DIRECT_MODE_DISPLAY_EXTENSION_NAME "VK_EXT_direct_mode_display") 143 | (defparameter VK_EXT_ACQUIRE_XLIB_DISPLAY_EXTENSION_NAME "VK_EXT_acquire_xlib_display") 144 | (defparameter VK_EXT_DISPLAY_SURFACE_COUNTER_EXTENSION_NAME "VK_EXT_display_surface_counter") 145 | (defparameter VK_EXT_DISPLAY_CONTROL_EXTENSION_NAME "VK_EXT_display_control") 146 | (defparameter VK_GOOGLE_DISPLAY_TIMING_EXTENSION_NAME "VK_GOOGLE_display_timing") 147 | (defparameter VK_KHR_EXTENSION_94_EXTENSION_NAME "VK_KHR_extension_94") 148 | (defparameter VK_NV_SAMPLE_MASK_OVERRIDE_COVERAGE_EXTENSION_NAME "VK_NV_sample_mask_override_coverage") 149 | (defparameter VK_NV_GEOMETRY_SHADER_PASSTHROUGH_EXTENSION_NAME "VK_NV_geometry_shader_passthrough") 150 | (defparameter VK_NV_VIEWPORT_ARRAY2_EXTENSION_NAME "VK_NV_viewport_array2") 151 | (defparameter VK_NVX_MULTIVIEW_PER_VIEW_ATTRIBUTES_EXTENSION_NAME "VK_NVX_multiview_per_view_attributes") 152 | (defparameter VK_NV_VIEWPORT_SWIZZLE_EXTENSION_NAME "VK_NV_viewport_swizzle") 153 | (defparameter VK_EXT_DISCARD_RECTANGLES_EXTENSION_NAME "VK_EXT_discard_rectangles") 154 | (defparameter VK_NV_EXTENSION_101_EXTENSION_NAME "VK_NV_extension_101") 155 | (defparameter VK_NV_EXTENSION_102_EXTENSION_NAME "VK_NV_extension_102") 156 | (defparameter VK_NV_EXTENSION_103_EXTENSION_NAME "VK_NV_extension_103") 157 | (defparameter VK_NV_EXTENSION_104_EXTENSION_NAME "VK_NV_extension_104") 158 | (defparameter VK_EXT_SWAPCHAIN_COLORSPACE_EXTENSION_NAME "VK_EXT_swapchain_colorspace") 159 | (defparameter VK_EXT_HDR_METADATA_EXTENSION_NAME "VK_EXT_hdr_metadata") 160 | (defparameter VK_IMG_EXTENSION_107_EXTENSION_NAME "VK_IMG_extension_107") 161 | (defparameter VK_IMG_EXTENSION_108_EXTENSION_NAME "VK_IMG_extension_108") 162 | (defparameter VK_IMG_EXTENSION_109_EXTENSION_NAME "VK_IMG_extension_109") 163 | (defparameter VK_IMG_EXTENSION_110_EXTENSION_NAME "VK_IMG_extension_110") 164 | (defparameter VK_IMG_EXTENSION_111_EXTENSION_NAME "VK_IMG_extension_111") 165 | (defparameter VK_KHR_SHARED_PRESENTABLE_IMAGE_EXTENSION_NAME "VK_KHR_shared_presentable_image") 166 | (defparameter VK_KHR_EXTENSION_113_EXTENSION_NAME "VK_KHR_extension_113") 167 | (defparameter VK_KHR_EXTENSION_114_EXTENSION_NAME "VK_KHR_extension_114") 168 | (defparameter VK_KHR_EXTENSION_115_EXTENSION_NAME "VK_KHR_extension_115") 169 | (defparameter VK_KHR_EXTENSION_116_EXTENSION_NAME "VK_KHR_extension_116") 170 | (defparameter VK_KHR_EXTENSION_117_EXTENSION_NAME "VK_KHR_extension_117") 171 | (defparameter VK_KHR_EXTENSION_118_EXTENSION_NAME "VK_KHR_extension_118") 172 | (defparameter VK_KHR_EXTENSION_119_EXTENSION_NAME "VK_KHR_extension_119") 173 | (defparameter VK_KHR_GET_SURFACE_CAPABILITIES2_EXTENSION_NAME "VK_KHR_get_surface_capabilities2") 174 | (defparameter VK_KHR_VARIABLE_POINTERS_EXTENSION_NAME "VK_KHR_variable_pointers") 175 | (defparameter VK_KHR_EXTENSION_122_EXTENSION_NAME "VK_KHR_extension_122") 176 | (defparameter VK_MVK_IOS_SURFACE_EXTENSION_NAME "VK_MVK_ios_surface") 177 | (defparameter VK_MVK_MACOS_SURFACE_EXTENSION_NAME "VK_MVK_macos_surface") 178 | (defparameter VK_MVK_MOLTENVK_EXTENSION_NAME "VK_MVK_moltenvk") 179 | (defparameter VK_MESA_EXTENSION_126_EXTENSION_NAME "VK_MESA_extension_126") 180 | (defparameter VK_MESA_EXTENSION_127_EXTENSION_NAME "VK_MESA_extension_127") 181 | (defparameter VK_KHR_EXTENSION_128_EXTENSION_NAME "VK_KHR_extension_128") 182 | (defparameter VK_EXT_EXTENSION_129_EXTENSION_NAME "VK_EXT_extension_129") 183 | (defparameter VK_KHR_EXTENSION_130_EXTENSION_NAME "VK_KHR_extension_130") 184 | (defparameter VK_KHR_EXTENSION_131_EXTENSION_NAME "VK_KHR_extension_131") 185 | (defparameter VK_KHR_EXTENSION_132_EXTENSION_NAME "VK_KHR_extension_132") 186 | (defparameter VK_AMD_EXTENSION_133_EXTENSION_NAME "VK_AMD_extension_133") 187 | (defparameter VK_AMD_EXTENSION_134_EXTENSION_NAME "VK_AMD_extension_134") 188 | (defparameter VK_AMD_EXTENSION_135_EXTENSION_NAME "VK_AMD_extension_135") 189 | (defparameter VK_AMD_EXTENSION_136_EXTENSION_NAME "VK_AMD_extension_136") 190 | (defparameter VK_AMD_EXTENSION_137_EXTENSION_NAME "VK_AMD_extension_137") 191 | (defparameter VK_AMD_EXTENSION_138_EXTENSION_NAME "VK_AMD_extension_138") 192 | (defparameter VK_AMD_EXTENSION_139_EXTENSION_NAME "VK_AMD_extension_139") 193 | (defparameter VK_AMD_EXTENSION_140_EXTENSION_NAME "VK_AMD_extension_140") 194 | (defparameter VK_AMD_EXTENSION_141_EXTENSION_NAME "VK_AMD_extension_141") 195 | (defparameter VK_AMD_EXTENSION_142_EXTENSION_NAME "VK_AMD_extension_142") 196 | (defparameter VK_AMD_EXTENSION_143_EXTENSION_NAME "VK_AMD_extension_143") 197 | (defparameter VK_AMD_EXTENSION_144_EXTENSION_NAME "VK_AMD_extension_144") 198 | (defparameter VK_KHR_RELAXED_BLOCK_LAYOUT_EXTENSION_NAME "VK_KHR_relaxed_block_layout") 199 | (defparameter VK_KHR_EXTENSION_146_EXTENSION_NAME "VK_KHR_extension_146") 200 | (defparameter VK_KHR_EXTENSION_147_EXTENSION_NAME "VK_KHR_extension_147") 201 | (defparameter VK_EXT_EXTENSION_148_EXTENSION_NAME "VK_EXT_extension_148") 202 | (defparameter VK_NV_EXTENSION_149_EXTENSION_NAME "VK_NV_extension_149") 203 | (defparameter VK_NV_EXTENSION_150_EXTENSION_NAME "VK_NV_extension_150") 204 | (defparameter VK_NV_EXTENSION_151_EXTENSION_NAME "VK_NV_extension_151") 205 | (defparameter VK_NV_EXTENSION_152_EXTENSION_NAME "VK_NV_extension_152") 206 | (defparameter VK_NV_EXTENSION_153_EXTENSION_NAME "VK_NV_extension_153") 207 | (defparameter VK_NV_EXTENSION_154_EXTENSION_NAME "VK_NV_extension_154") 208 | (defparameter VK_NV_EXTENSION_155_EXTENSION_NAME "VK_NV_extension_155") 209 | (defparameter VK_NV_EXTENSION_156_EXTENSION_NAME "VK_NV_extension_156") 210 | (defparameter VK_KHR_EXTENSION_157_EXTENSION_NAME "VK_KHR_extension_157") 211 | (defparameter VK_KHR_EXTENSION_158_EXTENSION_NAME "VK_KHR_extension_158") 212 | (defparameter VK_EXT_EXTENSION_159_EXTENSION_NAME "VK_EXT_extension_159") 213 | 214 | 215 | (defun check-vk-result (result) 216 | (case result 217 | (#.VK_SUCCESS (values)) 218 | (#.VK_NOT_READY (warn "A fence or query has not yet completed.") (values)) 219 | (#.VK_TIMEOUT (warn "A wait operation has not completed in the specified time.") (values)) 220 | (#.VK_EVENT_SET (format *error-output* "An event is signaled.") (values)) 221 | (#.VK_EVENT_RESET (format *error-output* "An even is unsignaled.") (values)) 222 | (#.VK_INCOMPLETE (warn "A return array was too small for the result.") (values)) 223 | 224 | (#.VK_ERROR_OUT_OF_HOST_MEMORY 225 | (error "A host memory allocation has failed.")) 226 | (#.VK_ERROR_OUT_OF_DEVICE_MEMORY 227 | (error "A device memory allocation has failed.")) 228 | (#.VK_ERROR_INITIALIZATION_FAILED 229 | (error "Initialization of an object has failed.")) 230 | (#.VK_ERROR_DEVICE_LOST 231 | (error "The logical device has been lost.")) 232 | (#.VK_ERROR_MEMORY_MAP_FAILED 233 | (error "Mapping of a memory object has failed.")) 234 | (#.VK_ERROR_LAYER_NOT_PRESENT 235 | (error "Layer specified does not exist.")) 236 | (#.VK_ERROR_EXTENSION_NOT_PRESENT 237 | (error "Extension specified does not exist.")) 238 | (#.VK_ERROR_FEATURE_NOT_PRESENT 239 | (error "Requested feature is not available on this device.")) 240 | (#.VK_ERROR_INCOMPATIBLE_DRIVER 241 | (error "Unable to find vulkan driver.")) 242 | (#.VK_ERROR_TOO_MANY_OBJECTS 243 | (error "Too many objects of this type have already been created.")) 244 | (#.VK_ERROR_FORMAT_NOT_SUPPORTED 245 | (error "Requested format is not supported on this device.")) 246 | (#.VK_ERROR_FRAGMENTED_POOL 247 | (error "A requested pool allocation has failed due to fragmentation of the pool's memory.")) 248 | (#.VK_ERROR_SURFACE_LOST_KHR 249 | (error "VK_KHR_surface: VK_ERROR_SURFACE_LOST_KHR")) 250 | (#.VK_ERROR_NATIVE_WINDOW_IN_USE_KHR 251 | (error "VK_KHR_surface: VK_ERROR_NATIVE_WINDOW_IN_USE")) 252 | (#.VK_SUBOPTIMAL_KHR 253 | (warn "VK_KHR_swapchain: VK_SUBOPTIMAL_KHR") (values)) 254 | (#.VK_ERROR_OUT_OF_DATE_KHR 255 | (error "VK_KHR_swapchain: VK_ERROR_OUT_OF_DATE_KHR")) 256 | (#.VK_ERROR_INCOMPATIBLE_DISPLAY_KHR 257 | (error "VK_KHR_display_swapchain: VK_INCOMPATIBLE_DISPLAY")) 258 | (#.VK_ERROR_VALIDATION_FAILED_EXT 259 | (error "VK_EXT_debug_report: VK_ERROR_VALIDATION_FAILED")) 260 | (#.VK_ERROR_INVALID_SHADER_NV 261 | (error "VK_NV_glsl_shader: VK_ERROR_INVALID_SHADER_NV")) 262 | (#.VK_NV_EXTENSION_1_ERROR 263 | (error "VK_NV_extension_1: VK_NV_EXTENSION_1_ERROR")) 264 | (#.VK_ERROR_OUT_OF_POOL_MEMORY_KHR 265 | (error "VK_KHR_maintenance1: VK_ERROR_OUT_OF_POOL_MEMORY_KHR")) 266 | (#.VK_ERROR_INVALID_EXTERNAL_HANDLE_KHX 267 | (error "VK_KHX_external_memory: VK_ERROR_INVALID_EXTERNAL_HANDLE_KHX")) 268 | (t (error "Unknown VkResult: ~S" result)))) 269 | -------------------------------------------------------------------------------- /src/surface-capabilities.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defmethod capabilities-current-extent-width ((cap surface-capabilities)) 25 | (extent-2D-width (slot-value cap 'current-extent))) 26 | 27 | (defmethod capabilities-current-extent-height ((cap surface-capabilities)) 28 | (extent-2D-height (slot-value cap 'current-extent))) 29 | 30 | (defun get-physical-device-surface-capabilities-khr (gpu surface) 31 | (with-foreign-object (p-surface-capabilities '(:struct VkSurfaceCapabilitiesKHR)) 32 | (check-vk-result (vkGetPhysicalDeviceSurfaceCapabilitiesKHR (h gpu) (h surface) p-surface-capabilities)) 33 | (with-foreign-slots ((%vk::minImageCount 34 | %vk::maxImageCount 35 | %vk::maxImageArrayLayers 36 | %vk::supportedTransforms 37 | %vk::currentTransform 38 | %vk::supportedCompositeAlpha 39 | %vk::supportedUsageFlags) 40 | p-surface-capabilities 41 | (:struct VkSurfaceCapabilitiesKHR)) 42 | (make-instance 'surface-capabilities 43 | :min-image-count %vk::minImageCount 44 | :max-image-count %vk::maxImageCount 45 | :current-extent (let ((p-extent 46 | (foreign-slot-pointer p-surface-capabilities 47 | '(:struct VkSurfaceCapabilitiesKHR) 48 | '%vk::currentExtent))) 49 | (make-instance 'extent-2D 50 | :width (foreign-slot-value p-extent 51 | '(:struct VkExtent2D) 52 | '%vk::width) 53 | :height (foreign-slot-value p-extent 54 | '(:struct VkExtent2D) 55 | '%vk::height))) 56 | :min-image-extent (let ((p-extent 57 | (foreign-slot-pointer p-surface-capabilities 58 | '(:struct VkSurfaceCapabilitiesKHR) 59 | '%vk::minImageExtent))) 60 | (make-instance 'extent-2D 61 | :width (foreign-slot-value p-extent 62 | '(:struct VkExtent2D) 63 | '%vk::width) 64 | :height (foreign-slot-value p-extent 65 | '(:struct VkExtent2D) 66 | '%vk::height))) 67 | :max-image-extent (let ((p-extent 68 | (foreign-slot-pointer p-surface-capabilities 69 | '(:struct VkSurfaceCapabilitiesKHR) 70 | '%vk::maxImageExtent))) 71 | (make-instance 'extent-2D 72 | :width (foreign-slot-value p-extent 73 | '(:struct VkExtent2D) 74 | '%vk::width) 75 | :height (foreign-slot-value p-extent 76 | '(:struct VkExtent2D) 77 | '%vk::height))) 78 | :max-image-array-layers %vk::maxImageArrayLayers 79 | :supported-transforms %vk::supportedTransforms 80 | :current-transform %vk::currentTransform 81 | :supported-composite-alpha %vk::supportedCompositeAlpha 82 | :supported-usage-flags %vk::supportedUsageFlags)))) 83 | -------------------------------------------------------------------------------- /src/surface-format.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun get-surface-formats (gpu surface) 25 | (with-foreign-object (p-count :uint32) 26 | (check-vk-result (vkGetPhysicalDeviceSurfaceFormatsKHR (h gpu) (h surface) p-count +nullptr+)) 27 | (let ((count (mem-aref p-count :uint32))) 28 | (let ((p-formats (foreign-alloc '(:struct VkSurfaceFormatKHR) :count count))) 29 | (check-vk-result (vkGetPhysicalDeviceSurfaceFormatsKHR (h gpu) (h surface) p-count p-formats)) 30 | (loop for i from 0 below (mem-aref p-count :uint32) 31 | collect (let ((p-format (mem-aptr p-formats '(:struct VkSurfaceFormatKHR) i))) 32 | (make-instance 'surface-format 33 | :format (foreign-slot-value p-format '(:struct VkSurfaceFormatKHR) '%vk::format) 34 | :color-space (foreign-slot-value p-format '(:struct VkSurfaceFormatKHR) '%vk::colorSpace)))))))) 35 | 36 | (defun find-supported-depth-format (gpu &key (candidates 37 | (list VK_FORMAT_D32_SFLOAT 38 | VK_FORMAT_D32_SFLOAT_S8_UINT 39 | Vk_FORMAT_D24_UNORM_S8_UINT)) 40 | 41 | (tiling VK_IMAGE_TILING_OPTIMAL) 42 | (features VK_FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT)) 43 | (loop for format in candidates 44 | do (with-vk-struct (p-props VkFormatProperties) 45 | (vkGetPhysicalDeviceFormatProperties (h gpu) format p-props) 46 | (with-foreign-slots ((%vk::linearTilingFeatures 47 | %vk::optimalTilingFeatures) 48 | p-props (:struct VkFormatProperties)) 49 | 50 | (when (and (eq tiling VK_IMAGE_TILING_LINEAR) 51 | (eq (logand %vk::linearTilingFeatures features) features)) 52 | (return format)) 53 | (when (and (eq tiling VK_IMAGE_TILING_OPTIMAL) 54 | (eq (logand %vk::optimalTilingFeatures features) features)) 55 | (return format)))) 56 | finally (error "Failed to find supported format."))) 57 | 58 | (defun find-supported-format (surface &key (requested-image-format VK_FORMAT_B8G8R8A8_UNORM) 59 | (requested-color-space VK_COLOR_SPACE_SRGB_NONLINEAR_KHR)) 60 | (loop for format in (supported-formats surface) 61 | do (when (and (eq (surface-format-format format) requested-image-format) 62 | (eq (surface-format-color-space format) requested-color-space)) 63 | (return format)) 64 | finally (let ((first-format (first (supported-formats surface)))) 65 | (when (eq (surface-format-format first-format) VK_FORMAT_UNDEFINED) 66 | (setf (surface-format-format first-format) requested-image-format 67 | (surface-format-color-space first-format) requested-color-space)) 68 | (return first-format)))) 69 | 70 | (defun has-stencil-component-p (format) 71 | (or (eq format VK_FORMAT_D32_SFLOAT_S8_UINT) 72 | (eq format VK_FORMAT_D24_UNORM_S8_UINT))) 73 | -------------------------------------------------------------------------------- /src/surface.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defun get-queue-family-index-with-wsi-support (gpu surface) 25 | ;; Check for WSI support 26 | (loop for i from 0 below (length (queue-families gpu)) 27 | do (with-foreign-object (p-res 'VkBool32) 28 | (check-vk-result (vkGetPhysicalDeviceSurfaceSupportKHR (h gpu) i (h surface) p-res)) 29 | (when (eq (mem-aref p-res 'VkBool32) VK_TRUE) 30 | (return i))) 31 | finally (error "No WSI support on physical device"))) 32 | 33 | (defun supports-presentation-mode-p (surface presentation-mode) 34 | (loop for mode in (presentation-modes surface) 35 | when (eq mode presentation-mode) 36 | do (return t))) 37 | 38 | (defun create-window-surface (device window &key (allocator +null-allocator+)) 39 | (let* ((surface 40 | (setf (render-surface window) 41 | (clui::create-native-window-surface (clui::window-display window) (get-vulkan-instance) window allocator))) 42 | (gpu (physical-device device)) 43 | (index (get-queue-family-index-with-wsi-support gpu surface))) 44 | (initialize-window-surface surface gpu index) 45 | surface)) 46 | 47 | 48 | (defun initialize-window-surface (surface gpu queue-family-index) 49 | (setf (paired-gpu surface) gpu) 50 | (setf (supported-formats surface) (get-surface-formats gpu surface)) 51 | (setf (presentation-modes surface) (get-present-modes gpu surface)) 52 | (setf (queue-family-index surface) queue-family-index) 53 | t) 54 | 55 | (defun pick-graphics-gpu (gpus surface) 56 | (loop for gpu in gpus 57 | do (let ((index (get-queue-family-index-with-wsi-support gpu surface))) 58 | (when index (return (values gpu index)))) 59 | finally (error "Could not find a gpu with window system integration support."))) 60 | -------------------------------------------------------------------------------- /src/utilities.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (declaim (inline clampf)) 4 | (declaim (inline clampf) (ftype (function (real) single-float) clampf)) 5 | (defun clampf (number) 6 | "Clamp real number to single-float limits." 7 | (block nil 8 | (when (typep number 'single-float) 9 | (return number)) 10 | (etypecase number 11 | (real 12 | (etypecase number 13 | (double-float 14 | (when (= number 0.0d0) 15 | (return 0.0f0)) 16 | (when (< (cl:the double-float (load-time-value (/ least-negative-single-float 2.0d0))) 17 | number 18 | (cl:the double-float (load-time-value (/ least-positive-single-float 2.0d0)))) 19 | (return 0.0f0)) 20 | (when (< number 0.0d0) 21 | (when (> number (cl:the single-float least-negative-single-float)) 22 | (return least-negative-single-float)) 23 | (when (< number (cl:the single-float most-negative-single-float)) 24 | (return most-negative-single-float)) 25 | (return (coerce number 'single-float))) 26 | (when (< number (cl:the single-float least-positive-single-float)) 27 | (return least-positive-single-float)) 28 | (when (> number (cl:the single-float most-positive-single-float)) 29 | (return most-positive-single-float)) 30 | (coerce number 'single-float)) 31 | (integer 32 | (when (= number 0) 33 | (return 0.0f0)) 34 | (when (< number (cl:the single-float most-negative-single-float)) 35 | (return most-negative-single-float)) 36 | (when (> number (cl:the single-float most-positive-single-float)) 37 | (return most-positive-single-float)) 38 | (coerce number 'single-float)) 39 | (rational 40 | (when (< (cl:the double-float (load-time-value (/ least-negative-single-float 2.0d0))) 41 | number 42 | (cl:the double-float (load-time-value (/ least-positive-single-float 2.0d0)))) 43 | (return 0.0f0)) 44 | (when (< number 0) 45 | (when (> number (cl:the single-float least-negative-single-float)) 46 | (return least-negative-single-float)) 47 | (return (coerce number 'single-float))) 48 | (when (< number (cl:the single-float least-positive-single-float)) 49 | (return least-positive-single-float)) 50 | (coerce number 'single-float))))))) 51 | -------------------------------------------------------------------------------- /src/vulkan-application.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | (in-package :vk) 22 | 23 | (defmethod shutdown-display ((dpy vulkan-enabled-display-mixin)) 24 | (let* ((device (default-logical-device dpy))) 25 | 26 | (device-wait-idle device) 27 | 28 | (destroy-memory-pools dpy) 29 | 30 | (vkDestroyDescriptorPool (h device) 31 | vk::VK_NULL_HANDLE 32 | +nullptr+) 33 | 34 | (let ((command-pools (command-pools device))) 35 | (mapcar #'(lambda (cons) 36 | (let ((command-pool (cadr cons))) 37 | (when command-pool 38 | (loop for command-buffer across (command-buffers command-pool) 39 | do (free-command-buffer command-buffer) 40 | finally (setf (fill-pointer (command-buffers command-pool)) 0)) 41 | (destroy-command-pool command-pool)))) 42 | command-pools)) 43 | 44 | (when (next-method-p) 45 | (call-next-method)) 46 | 47 | (vkDestroyDevice (h device) (h (allocator device))) 48 | (values))) 49 | 50 | (defmethod required-vulkan-device-extensions ((display vulkan-enabled-display-mixin)) 51 | (list #-darwin "VK_EXT_line_rasterization")) 52 | 53 | (defmethod initialize-instance :before ((instance vulkan-enabled-display-mixin) 54 | &rest initargs &key &allow-other-keys) 55 | (let ((vulkan-device-extensions (getf initargs :vulkan-device-extensions))) 56 | (remf initargs :vulkan-device-extensions) 57 | (setq vulkan-device-extensions 58 | (append (required-vulkan-device-extensions instance) 59 | vulkan-device-extensions)) 60 | (apply #'setup-vulkan instance :vulkan-device-extensions vulkan-device-extensions initargs) 61 | (initialize-buffer-memory-pool instance) 62 | (values))) 63 | 64 | (defun setup-vulkan (dpy &rest args 65 | &key (compute-queue-count 0) 66 | (vulkan-device-extensions nil) 67 | (wide-lines #+(or windows linux) t #+(or darwin) nil) 68 | (rectangular-lines nil) 69 | (stippled-lines #+(or windows linux) t #+(or darwin) nil) 70 | &allow-other-keys) 71 | (let ((vulkan-instance (get-vulkan-instance dpy))) 72 | (let ((debug-callback (when (debug-report-present? vulkan-instance) 73 | (create-debug-report-callback vulkan-instance 'debug-report-callback)))) 74 | (setf (debug-callback vulkan-instance) debug-callback) 75 | 76 | (let ((physical-devices (enumerate-physical-devices dpy))) 77 | 78 | (setf (system-gpus dpy) physical-devices) 79 | 80 | (multiple-value-bind (gpu index) (block get-gpu 81 | (loop for gpu in physical-devices 82 | do (loop for queue-family in (queue-families gpu) for i from 0 83 | do (let ((queue-flags (slot-value queue-family 'queue-flags))) 84 | (when (not (zerop (logand queue-flags VK_QUEUE_GRAPHICS_BIT))) 85 | (return-from get-gpu (values gpu i))))))) 86 | ;;(declare (ignore index)) 87 | (when (null gpu) 88 | (error "No graphics device available.")) 89 | #+NIL(pick-graphics-gpu physical-devices surface) 90 | 91 | (let* ((device (apply #'create-logical-device dpy gpu 92 | :compute-queue-count compute-queue-count 93 | :device-extensions 94 | (list* VK_KHR_SWAPCHAIN_EXTENSION_NAME 95 | vulkan-device-extensions) 96 | :rectangular-lines rectangular-lines 97 | :stippled-lines stippled-lines 98 | :enable-wide-lines wide-lines 99 | :enable-geometry-shader (has-geometry-shader-p gpu) 100 | args))) 101 | 102 | (setf (default-logical-device dpy) device) 103 | 104 | (let ((command-pool (create-command-pool device index))) 105 | (push (list index command-pool) (command-pools device)) 106 | (create-command-buffer device command-pool)) 107 | 108 | (unless (or (zerop compute-queue-count) 109 | (null compute-queue-count)) 110 | ;; todo: this needs to work for compute-queue-count > 1 111 | (multiple-value-bind (compute-queue compute-qfi) 112 | (compute-queue device) 113 | (declare (ignore compute-queue)) 114 | (let ((command-pool (or (find-command-pool device compute-qfi) 115 | (create-command-pool device compute-qfi)))) 116 | (loop for i from 0 below compute-queue-count 117 | do (create-command-buffer device command-pool))))) 118 | 119 | (setf (default-descriptor-pool dpy) (create-descriptor-pool device)) 120 | 121 | (values))))))) 122 | -------------------------------------------------------------------------------- /src/vulkan-instance.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defvar *vulkan-instance* nil) 25 | 26 | (defmethod get-required-instance-extensions ((system-object t)) 27 | #+linux 28 | (get-x11-required-instance-extensions) 29 | #+darwin 30 | (get-cocoa-required-instance-extensions) 31 | #+win32 32 | (get-win32-required-instance-extensions)) 33 | 34 | (defun get-vulkan-instance (&optional system-object) 35 | (if *vulkan-instance* 36 | *vulkan-instance* 37 | (setq *vulkan-instance* 38 | (create-instance system-object)))) 39 | 40 | (defun enumerate-instance-layer-properties () 41 | (with-foreign-object (p-property-count :int) 42 | (check-vk-result (vkEnumerateInstanceLayerProperties p-property-count +nullptr+)) 43 | (let ((property-count (mem-aref p-property-count :int))) 44 | (with-foreign-object (p-properties '(:struct VkLayerProperties) property-count) 45 | (check-vk-result (vkEnumerateInstanceLayerProperties p-property-count p-properties)) 46 | (remove-duplicates 47 | (loop for i from 0 below (mem-aref p-property-count :int) 48 | collect (let ((p-property (mem-aptr p-properties '(:struct VkLayerProperties) i))) 49 | (list (foreign-string-to-lisp (foreign-slot-pointer p-property '(:struct VkLayerProperties) '%vk::layerName)) 50 | (foreign-slot-value p-property '(:struct VkLayerProperties) '%vk::specVersion) 51 | (foreign-slot-value p-property '(:struct VkLayerProperties) '%vk::implementationVersion) 52 | (foreign-string-to-lisp (foreign-slot-pointer p-property '(:struct VkLayerProperties) '%vk::description))))) 53 | :test #'equalp))))) 54 | 55 | (defun enumerate-instance-extension-properties (layer-name) 56 | (with-foreign-string (p-layer-name layer-name) 57 | (with-foreign-object (p-property-count :int) 58 | (check-vk-result (vkEnumerateInstanceExtensionProperties p-layer-name p-property-count +nullptr+)) 59 | (let ((property-count (mem-aref p-property-count :int))) 60 | (with-foreign-object (p-properties '(:struct VkExtensionProperties) property-count) 61 | (check-vk-result (vkEnumerateInstanceExtensionProperties p-layer-name p-property-count p-properties)) 62 | (remove-duplicates 63 | (loop for i from 0 below (mem-aref p-property-count :int) 64 | append (let ((p-property (mem-aptr p-properties '(:struct VkExtensionProperties) i))) 65 | (list (foreign-string-to-lisp (foreign-slot-pointer p-property '(:struct VkExtensionProperties) '%vk::extensionName)) 66 | (foreign-slot-value p-property '(:struct VkExtensionProperties) '%vk::specVersion)))) 67 | :test #'equalp)))))) 68 | 69 | (defun available-layers () 70 | (mapcar #'first (enumerate-instance-layer-properties))) 71 | 72 | (defun available-extensions () 73 | (let ((list (mapcar #'first (remove-duplicates (remove-if #'null (mapcar #'enumerate-instance-extension-properties (available-layers))) :test #'equalp)))) 74 | #+darwin (list* "VK_KHR_portability_enumeration" 75 | "VK_KHR_get_physical_device_properties2" 76 | list) 77 | #-darwin list)) 78 | 79 | (defun destroy-vulkan-instance (instance) 80 | (when instance 81 | (when (debug-callback instance) 82 | (destroy-debug-report-callback (debug-callback instance))) 83 | (loop for device in (logical-devices instance) 84 | do (let ((command-pools (command-pools device))) 85 | (loop for entry in command-pools 86 | do (free-command-buffers (second entry)) 87 | (vkDestroyCommandPool (h device) (h (second entry)) (h (allocator device))))) 88 | finally (vkDestroyDevice (h device) (h (allocator device)))) 89 | (vkDestroyInstance (h instance) (h (allocator instance))) 90 | (setq *vulkan-instance* nil) 91 | t)) 92 | 93 | (defun create-instance (system-object &key (title "CL-Vulkan Demo") 94 | (application-name title) 95 | (application-version 0) 96 | (engine-name "") 97 | (engine-version 0) 98 | layer-names 99 | extension-names 100 | (api-version (api-version 1 3 250)) 101 | (allocator +null-allocator+) 102 | &allow-other-keys) 103 | 104 | #+(and sbcl darwin)(sb-int:set-floating-point-modes :traps nil) 105 | (let ((available-layers (available-layers)) 106 | (available-extensions (available-extensions))) 107 | 108 | #+darwin(pushnew "VK_KHR_portability_enumeration" extension-names :test #'string=) 109 | #+darwin(pushnew "VK_KHR_get_physical_device_properties2" extension-names :test #'string=) 110 | 111 | (when (and (numberp *debug*) (> *debug* 1) 112 | (find "VK_LAYER_LUNARG_api_dump" available-layers :test #'string=)) 113 | (pushnew "VK_LAYER_LUNARG_api_dump" layer-names :test #'string=)) 114 | 115 | (loop for layer in layer-names 116 | unless (find layer available-layers :test #'string=) 117 | do (error "layer ~S is not available" layer)) 118 | 119 | (loop for ext in extension-names 120 | unless (find ext available-extensions :test #'string=) 121 | do (error "extension ~S is not available" ext))) 122 | 123 | #+glfw 124 | (when (zerop (glfwInit)) 125 | (error "GLFW failed to initialize.")) 126 | 127 | (let* ((required-extensions (get-required-instance-extensions system-object)) 128 | (required-extension-count (length required-extensions)) 129 | (extension-count (+ (length extension-names) required-extension-count)) 130 | (layer-count (length layer-names))) 131 | 132 | (loop for extension in required-extensions 133 | do (push extension extension-names)) 134 | 135 | (with-foreign-objects 136 | ((pp-enabled-extension-names-with-debug '(:pointer :char) (1+ extension-count)) 137 | (pp-enabled-extension-names '(:pointer :char) extension-count) 138 | (pp-enabled-layer-names-with-validation '(:pointer :char) (1+ layer-count)) 139 | (pp-enabled-layer-names '(:pointer :char) layer-count)) 140 | 141 | (unwind-protect 142 | (progn 143 | (loop for i from 0 144 | for extension-string in extension-names 145 | do 146 | (setf 147 | (mem-aref pp-enabled-extension-names-with-debug '(:pointer :char) i) 148 | (foreign-string-alloc extension-string) 149 | (mem-aref pp-enabled-extension-names '(:pointer :char) i) 150 | (foreign-string-alloc extension-string)) 151 | finally 152 | (setf 153 | (mem-aref pp-enabled-extension-names-with-debug '(:pointer :char) i) 154 | (foreign-string-alloc VK_EXT_DEBUG_REPORT_EXTENSION_NAME))) 155 | 156 | (loop for i from 0 157 | for layer-string in layer-names 158 | do 159 | (setf 160 | (mem-aref pp-enabled-layer-names-with-validation '(:pointer :char) i) 161 | (foreign-string-alloc layer-string) 162 | (mem-aref pp-enabled-layer-names '(:pointer :char) i) 163 | (foreign-string-alloc layer-string)) 164 | finally 165 | (setf 166 | (mem-aref pp-enabled-layer-names-with-validation '(:pointer :char) i) 167 | #-NVIDIA 168 | (foreign-string-alloc "VK_LAYER_KHRONOS_validation") 169 | #+NVIDIA 170 | (foreign-string-alloc "VK_LAYER_LUNARG_standard_validation"))) 171 | 172 | (with-vk-struct (p-application-info VkApplicationInfo) 173 | (with-foreign-slots ((%vk::pApplicationName 174 | %vk::applicationVersion 175 | %vk::pEngineName 176 | %vk::engineVersion 177 | %vk::apiVersion) 178 | p-application-info 179 | (:struct VkApplicationInfo)) 180 | (with-foreign-strings ((p-application-name application-name) 181 | (p-engine-name engine-name)) 182 | (setf %vk::pApplicationName p-application-name 183 | %vk::applicationVersion application-version 184 | %vk::pEngineName p-engine-name 185 | %vk::engineVersion engine-version 186 | %vk::apiVersion api-version) 187 | 188 | (with-foreign-object (p-instance 'VkInstance) 189 | (with-vk-struct (p-create-info VkInstanceCreateInfo) 190 | ;; note: pNext takes pointers to structures (usually for callbacks) 191 | ;; which should be implemented at some point. 192 | (with-foreign-slots ((%vk::pApplicationInfo 193 | %vk::enabledExtensionCount 194 | %vk::ppEnabledExtensionNames 195 | %vk::enabledLayerCount 196 | %vk::ppEnabledLayerNames 197 | %vk::flags) 198 | p-create-info 199 | (:struct VkInstanceCreateInfo)) 200 | 201 | (setf %vk::pApplicationInfo p-application-info) 202 | #+darwin(setf %vk::flags %vk::VK_INSTANCE_CREATE_ENUMERATE_PORTABILITY_BIT) 203 | 204 | (flet ((try-create-inst (&key debug validation) 205 | (let ((1+extension-count (1+ extension-count)) 206 | (1+layer-count (1+ layer-count))) 207 | 208 | (if debug 209 | (setf %vk::ppEnabledExtensionNames pp-enabled-extension-names-with-debug 210 | %vk::enabledExtensionCount 1+extension-count) 211 | (setf %vk::ppEnabledExtensionNames pp-enabled-extension-names 212 | %vk::enabledExtensionCount extension-count)) 213 | 214 | (if validation 215 | (setf %vk::ppEnabledLayerNames pp-enabled-layer-names-with-validation 216 | %vk::enabledLayerCount 1+layer-count) 217 | (setf %vk::ppEnabledLayerNames pp-enabled-layer-names 218 | %vk::enabledLayerCount layer-count))) 219 | 220 | (vkCreateInstance p-create-info (h allocator) p-instance))) 221 | 222 | (let ((result) 223 | (debug-report-present nil)) 224 | (block try 225 | (if *debug* 226 | (progn 227 | (setq result (try-create-inst :validation t :debug t)) 228 | (if (eq result VK_ERROR_LAYER_NOT_PRESENT) 229 | (progn (warn "Trying to create vulkan instance with VK_LAYER_KHRONOS_validation failed, falling back...") 230 | (setq result (try-create-inst :debug t)) 231 | (if (eq result VK_ERROR_EXTENSION_NOT_PRESENT) 232 | (progn 233 | (warn "Trying to create vulkan instance with VK_EXT_debug_report failed, falling back...") 234 | (check-vk-result (try-create-inst))) 235 | (if (eq result VK_SUCCESS) 236 | (setq debug-report-present t) 237 | (check-vk-result result)))) 238 | (if (eq result VK_ERROR_EXTENSION_NOT_PRESENT) 239 | (progn (warn "Trying to create vulkan instance with VK_EXT_debug_report failed, falling back...") 240 | (setq result (try-create-inst :validation t)) 241 | (if (eq result VK_ERROR_LAYER_NOT_PRESENT) 242 | (warn "Trying to create vulkan instance with VK_LAYER_LUNARG_STANDARD_VALIDATION failed, falling back...") 243 | (if (eq result VK_SUCCESS) 244 | (setq debug-report-present t) 245 | (check-vk-result (try-create-inst))))) 246 | (if (eq result VK_SUCCESS) 247 | (setq debug-report-present t) 248 | (check-vk-result result))))) 249 | (check-vk-result (try-create-inst)))) 250 | 251 | (setq *vulkan-instance* 252 | (make-instance 'instance 253 | :handle (mem-aref p-instance 'VkInstance) 254 | :debug-report-present debug-report-present 255 | :allocator allocator))))))))))) 256 | 257 | (loop for i from 0 below extension-count 258 | do (foreign-string-free (mem-aref pp-enabled-extension-names-with-debug '(:pointer :char) i))) 259 | (loop for i from 0 below extension-count 260 | do (foreign-string-free (mem-aref pp-enabled-extension-names '(:pointer :char) i))) 261 | (loop for i from 0 below layer-count 262 | do (foreign-string-free (mem-aref pp-enabled-layer-names-with-validation '(:pointer :char) i))) 263 | (loop for i from 0 below layer-count 264 | do (foreign-string-free (mem-aref pp-enabled-layer-names '(:pointer :char) i))))))) 265 | -------------------------------------------------------------------------------- /src/win32.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (defun get-win32-required-instance-extensions () 4 | (list (symbol-value (intern "VK_KHR_SURFACE_EXTENSION_NAME" :vk)) 5 | (symbol-value (intern "VK_KHR_WIN32_SURFACE_EXTENSION_NAME" :vk)))) 6 | 7 | #| 8 | // Provided by VK_KHR_win32_surface 9 | typedef struct VkWin32SurfaceCreateInfoKHR { 10 | VkStructureType sType; 11 | const void* pNext; 12 | VkWin32SurfaceCreateFlagsKHR flags; 13 | HINSTANCE hinstance; 14 | HWND hwnd; 15 | } VkWin32SurfaceCreateInfoKHR; 16 | |# 17 | 18 | (cffi:defcstruct VkWin32SurfaceCreateInfoKHR 19 | (sType %vk::vkStructureType) 20 | (pNext :pointer) 21 | (flags :int) 22 | (hinstance :pointer) 23 | (hwnd :pointer)) 24 | 25 | #+NIL 26 | (defconstant VK_STRUCTURE_TYPE_WIN32_SURFACE_CREATE_INFO_KHR 1000009000) 27 | 28 | (defun create-win32-window-surface (instance window allocator) 29 | (let ((p-fn-vkCreateWin32SurfaceKHR 30 | (cffi:with-foreign-string (pstr "vkCreateWin32SurfaceKHR") 31 | (%vk:vkGetInstanceProcAddr (h instance) pstr))) 32 | (err nil)) 33 | 34 | (when (cffi:null-pointer-p p-fn-vkCreateWin32SurfaceKHR) 35 | (error "Win32: Vulkan instance missing VK_KHR_win32_surface extension.")) 36 | 37 | (cffi:with-foreign-object (p-info '(:struct VKWin32SurfaceCreateInfoKHR)) 38 | (cffi:with-foreign-slots ((sType 39 | hinstance 40 | hwnd) 41 | p-info 42 | (:struct VKWin32SurfaceCreateInfoKHR)) 43 | (vk::memset p-info 0 (cffi:foreign-type-size '(:struct VKWin32SurfaceCreateInfoKHR))) 44 | 45 | (setf sType VK_STRUCTURE_TYPE_WIN32_SURFACE_CREATE_INFO_KHR 46 | hinstance (h instance) 47 | hwnd (noffi::ptr-value (h window))) 48 | 49 | (cffi:with-foreign-object (p-surface 'vk::VkSurfaceKHR) 50 | (setq err (cffi:foreign-funcall-pointer p-fn-vkCreateWin32SurfaceKHR () 51 | :pointer (h instance) 52 | :pointer p-info 53 | :pointer (h allocator) 54 | :pointer p-surface 55 | :int)) 56 | 57 | (vk:check-vk-result err) 58 | 59 | (make-instance 'surface 60 | :handle (cffi:mem-aref p-surface 'vk::VkSurfaceKHR) 61 | :window window 62 | :allocator allocator)))))) 63 | -------------------------------------------------------------------------------- /src/window.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2019, 2020 Andrew Kenneth Wolven 2 | ;; 3 | ;; Permission is hereby granted, free of charge, to any person obtaining 4 | ;; a copy of this software and associated documentation files (the 5 | ;; "Software"), to deal in the Software without restriction, including 6 | ;; without limitation the rights to use, copy, modify, merge, publish, 7 | ;; distribute, sublicense, and/or sell copies of the Software, and to 8 | ;; permit persons to whom the Software is furnished to do so, subject to 9 | ;; the following conditions: 10 | ;; 11 | ;; The above copyright notice and this permission notice shall be 12 | ;; included in all copies or substantial portions of the Software. 13 | ;; 14 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | (in-package :vk) 23 | 24 | (defcallback error-callback :void ((error :int) (description (:pointer :char))) 25 | (error-callback-function error description)) 26 | 27 | (defun error-callback-function (error description) 28 | (format *error-output* "GLFW Error: ~A: ~A~%" error (foreign-string-to-lisp description)) 29 | (values)) 30 | 31 | #+NIL 32 | (defcallback window-close-callback :void ((window :pointer)) 33 | (glfwSetWindowShouldClose window GLFW_TRUE) 34 | (values)) 35 | 36 | #+NIL 37 | (defun set-window-close-callback (window &optional (callback-name 'window-close-callback)) 38 | (glfwSetWindowCloseCallback (h window) (get-callback callback-name))) 39 | 40 | #+glfw 41 | (defun find-window (handle) ;; todo: in the ffi define this slot as int or uint 42 | (gethash handle (window-registry *app*) 43 | :key #'h :test #'pointer-eq)) 44 | 45 | (defmethod clim:handle-event ((window vulkan-window-mixin) (event clui::window-resize-event-mixin)) 46 | (let ((width (clui::window-resize-event-new-width event)) 47 | (height (clui::window-resize-event-new-height event))) 48 | (unless (or (zerop width) (zerop height)) 49 | (unless (render-surface window) 50 | (clui::initialize-window-devices window 51 | :width width 52 | :height height)) 53 | (call-next-method) 54 | (setf (recreate-swapchain? window) t) 55 | (setf (window-initialized? window) t) 56 | (values)))) 57 | 58 | 59 | (defmethod clui::destroy-window ((window vulkan-window)) 60 | (destroy-os-window window)) 61 | 62 | (defmethod destroy-os-window ((window vulkan-window)) 63 | (let* ((dpy (clui:window-display window)) 64 | (device (default-logical-device dpy)) 65 | (vkinstance *vulkan-instance*)) 66 | (vkDeviceWaitIdle device) 67 | (destroy-swapchain (swapchain window)) 68 | (vkDestroySurfaceKHR (h vkinstance) (h (render-surface window)) (h (allocator device))))) 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/x11.lisp: -------------------------------------------------------------------------------- 1 | (in-package :vk) 2 | 3 | (defun get-x11-required-instance-extensions () 4 | ;; need some logic here to see if XCB actually works or if we need Xlib surface 5 | (list vk::VK_KHR_SURFACE_EXTENSION_NAME 6 | vk::VK_KHR_XLIB_SURFACE_EXTENSION_NAME 7 | vk::VK_KHR_XCB_SURFACE_EXTENSION_NAME)) 8 | 9 | #| 10 | // Provided by VK_KHR_xcb_surface 11 | typedef struct VkXcbSurfaceCreateInfoKHR { 12 | VkStructureType sType; 13 | const void* pNext; 14 | VkXcbSurfaceCreateFlagsKHR flags; 15 | xcb_connection_t* connection; 16 | xcb_window_t window; 17 | } VkXcbSurfaceCreateInfoKHR; 18 | |# 19 | 20 | (cffi:defcstruct VkXcbSurfaceCreateInfoKHR 21 | (sType %vk::vkStructureType) 22 | (pNext :pointer) 23 | (flags :int) 24 | (connection :pointer) 25 | (window :uint32)) 26 | 27 | (defconstant VK_STRUCTURE_TYPE_XCB_SURFACE_CREATE_INFO_KHR 1000005000) 28 | 29 | #| 30 | typedef struct VkXlibSurfaceCreateInfoKHR { 31 | VkStructureType sType; 32 | const void* pNext; 33 | VkXlibSurfaceCreateFlagsKHR flags; 34 | Display* dpy; 35 | Window window; 36 | } VkXlibSurfaceCreateInfoKHR; 37 | |# 38 | 39 | (cffi:defcstruct VkXlibSurfaceCreateInfoKHR 40 | (sType %vk::vkStructureType) 41 | (pNext :pointer) 42 | (flags :int) 43 | (dpy :pointer) 44 | (window :uint32)) 45 | 46 | (defconstant VK_STRUCTURE_TYPE_XLIB_SURFACE_CREATE_INFO_KHR 1000004000) 47 | 48 | #-glfw 49 | (defun create-x11-window-surface (display instance window allocator) 50 | (let ((err)) 51 | (cffi:with-foreign-object (p-surface 'vk::VkSurfaceKHR) 52 | 53 | (if (and (clui::xcb-available? (clui::display-x11-state display)) 54 | (clui::xcb-vulkan-surface? (clui::display-x11-state display))) 55 | 56 | (let ((xcb-connection (#_XGetXCBConnection (h display)))) 57 | (unless xcb-connection 58 | (error "X11: Failed to retrieve XCB connection.")) 59 | 60 | (let ((p-fn-vkCreateXCBSurfaceKHR 61 | (cffi:with-foreign-string (pstr "vkCreateXcbSurfaceKHR") 62 | (%vk:vkGetInstanceProcAddr (h instance) pstr)))) 63 | 64 | (cffi::with-foreign-object (p-info '(:struct VkXcbSurfaceCreateInfoKHR)) 65 | (cffi:with-foreign-slots ((sType 66 | pNext 67 | flags 68 | connection) 69 | p-info 70 | (:struct VkXcbSurfaceCreateInfoKHR)) 71 | (setf sType VK_STRUCTURE_TYPE_XCB_SURFACE_CREATE_INFO_KHR 72 | pNext (cffi:null-pointer) 73 | flags 0 74 | connection (noffi::ptr-value xcb-connection))) 75 | (setf (cffi:foreign-slot-value p-info '(:struct VkXcbSurfaceCreateInfoKHR) 'window) (h window)) 76 | 77 | (setq err (cffi:foreign-funcall-pointer p-fn-vkCreateXcbSurfaceKHR () 78 | :pointer (h instance) 79 | :pointer p-info 80 | :pointer (h allocator) 81 | :pointer p-surface 82 | :int))))) 83 | 84 | (let ((p-fn-vkCreateXlibSurfaceKHR 85 | (cffi:with-foreign-string (pstr "vkCreateXlibSurfaceKHR") 86 | (%vk:vkGetInstanceProcAddr (h instance) pstr)))) 87 | 88 | (cffi::with-foreign-object (p-info '(:struct VkXlibSurfaceCreateInfoKHR)) 89 | (cffi:with-foreign-slots ((sType 90 | pNext 91 | flags 92 | dpy) 93 | p-info 94 | (:struct VkXlibSurfaceCreateInfoKHR)) 95 | (setf sType VK_STRUCTURE_TYPE_XLIB_SURFACE_CREATE_INFO_KHR 96 | pNext (cffi:null-pointer) 97 | flags 0 98 | dpy (noffi::ptr-value (h display)))) 99 | (setf (cffi:foreign-slot-value p-info '(:struct VkXlibSurfaceCreateInfoKHR) 'window) (h window)) 100 | 101 | (setq err (cffi:foreign-funcall-pointer p-fn-vkCreateXlibSurfaceKHR () 102 | :pointer (h instance) 103 | :pointer p-info 104 | :pointer (h allocator) 105 | :pointer p-surface 106 | :int))))) 107 | 108 | 109 | (vk:check-vk-result err) 110 | 111 | (make-instance 'surface 112 | :handle (cffi:mem-aref p-surface 'vk::VkSurfaceKHR) 113 | :window window 114 | :allocator allocator)))) 115 | 116 | 117 | 118 | --------------------------------------------------------------------------------