├── .gitignore ├── LICENSE ├── README.md ├── examples ├── package.lisp ├── vao-shader-120.lisp ├── vao-shader-150.lisp ├── vao-shader-330.lisp ├── vao-shader-410.lisp ├── vao-shader-window.lisp └── vaos.lisp ├── glkit-examples.asd ├── glkit.asd └── src ├── package.lisp ├── protocol.lisp ├── shader-dict ├── macros.lisp ├── shaders.lisp └── uniforms.lisp ├── tex ├── fbo.lisp ├── texture.lisp └── util.lisp └── vao └── vao.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.lx??fsl 3 | *.dx??fsl 4 | *.wx??fsl 5 | #* 6 | *~ 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 Ryan Pavlik 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining 6 | a copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be 14 | included in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 21 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 22 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # glkit 2 | 3 | This is a utility kit for functionality related to OpenGL. Right now, 4 | it provides the following: 5 | 6 | * `kit.glm`: This re-exports [sb-cga](https://github.com/nikodemus/sb-cga) 7 | and [mathkit](https://github.com/lispgames/mathkit) for convenience. 8 | 9 | * `kit.gl.shader`: This provides shader dictionary and compilation 10 | functionality similar to what was originally found in 11 | [sdl2kit](https://github.com/lispgames/sdl2kit). 12 | 13 | * `kit.gl.vao`: This provides an interface for Vertex Array Objects. 14 | 15 | ## Shaders 16 | 17 | `kit.gl.shader` provides a thin, extensible, program-oriented model 18 | for GL shaders. This closely mimics how GL works: 19 | 20 | ```lisp 21 | (defdict shaders-3.3 (:shader-path #P"...") 22 | (shader basic-vertex :vertex-shader (:file "vertex.glsl")) 23 | (program :solid (:color) 24 | (:vertex-shader basic-vertex) 25 | (:fragment-shader "...")) 26 | (program (:sprite 27 | :uniforms ((:texture "texture_id")) 28 | :attrs ((:vertex 0) 29 | (:uv 1) 30 | ...)) 31 | (:vertex-shader basic-vertex) 32 | (:fragment-shader (:file "...")))) 33 | ``` 34 | 35 | This defines a series of shader programs grouped into a "dictionary". 36 | Once in a GL context, one or more dictionaries may be compiled, 37 | programs activated, and uniforms set, all symbolically. 38 | 39 | You may specify any legal combination of shaders in the shaders 40 | section. Reusing text between shaders is easy by defining named 41 | shaders with the `SHADER` directive. Text may also be loaded from a 42 | file using `(:file PATHNAME)` as above. Additional handling may be 43 | defined; see below. 44 | 45 | To actually compile and use a dictionary, call the following; it will 46 | attempt to compile and link all the specified programs, reporting any 47 | errors along the way to `*error-output*`: 48 | 49 | ```lisp 50 | (compile-shader-dictionary (dict shaders-3.3)) 51 | ;; => DICTIONARY 52 | ``` 53 | 54 | This **requires** a valid GL context, will only work when it is 55 | otherwise legal to make GL calls. As well, the returned 56 | `SHADER-DICTIONARY` object is only valid in the GL context in which it 57 | was compiled. It will **not** work in others. If desired, more than 58 | one dictionary may be compiled in a context; nothing besides 59 | convenience groups programs in a dictionary. 60 | 61 | Once you have this object, you may do interesting things with it: 62 | 63 | ```lisp 64 | (kit.gl.shader:use-program DICTIONARY :name) 65 | 66 | ;; Note these apply only to the *current program*, 67 | ;; different programs have different sets of uniforms 68 | (kit.gl.shader:uniformi DICTIONARY :v1 0) 69 | (kit.gl.shader:uniformf DICTIONARY :v2 x y) 70 | 71 | ;; etc 72 | ``` 73 | 74 | Note these are different functions than the `cl-opengl` variety; they 75 | take the *dictionary* object, as well as symbolic names, rather than 76 | IDs. 77 | 78 | ### Customizing 79 | 80 | It's also possible to define other ways to produce shader strings, by 81 | specializing either of the following generic functions: 82 | 83 | ```lisp 84 | (parse-shader-source SOURCE SHADER-TYPE SHADER-LIST) 85 | (parse-shader-source-complex KEY PARAMS SHADER-TYPE SHADER-LIST) 86 | ``` 87 | 88 | The first specializes on a few `SOURCE` types by default; do not alter 89 | these: 90 | 91 | * `string`: A simple string which is used directly as source 92 | * `list`: A list which is processed further by 93 | `PARSE-SHADER-SOURCE-COMPLEX` 94 | * `symbol`: A symbol which is looked up in the current list of "named" 95 | shaders 96 | 97 | The `SHADER-TYPE` parameter is any valid shader type, 98 | e.g. `:vertex-shader`; `SHADER-LIST` is the current list of "named" 99 | shaders, in the form `(NAME . (TYPE VALUE))`. Notably, `VALUE` is not 100 | processed, and should be passed recursively to `PARSE-SHADER-SOURCE` 101 | if used. 102 | 103 | To process forms like `(:file PATHNAME)`, 104 | `PARSE-SHADER-SOURCE-COMPLEX` takes the CAR and CDR or that list, as 105 | well other parameters similar to `PARSE-SHADER-SOURCE`. 106 | 107 | These are mostly useful for projects which desire to add extended 108 | shader capability, such as a shader DSL, or loading in some other 109 | manner. 110 | 111 | ## VAOs 112 | 113 | `kit.gl.vao` provides an easy way to define VAO layouts, as well as 114 | instantiate, bind, and draw them. It aims to provide complete VAO 115 | functionality. 116 | 117 | To use, first one defines a VAO: 118 | 119 | ```lisp 120 | (defvao NAME () 121 | (LAYOUT-TYPE (OPTS) 122 | (ATTR :type COUNT) 123 | ...) 124 | (LAYOUT-TYPE 125 | ...)) 126 | ``` 127 | 128 | For example: 129 | 130 | ```lisp 131 | (defvao vertex-color () 132 | (:separate () 133 | (vertex :float 3) 134 | (color :float 3))) 135 | ``` 136 | 137 | This defines a VAO with `VERTEX` and `COLOR` attributes, which are 138 | each 3 `:float` values. This uses a separate VBO for each. (The 139 | `LAYOUT-TYPE` will be covered below.) 140 | 141 | Using a VAO is just as easy: 142 | 143 | ```lisp 144 | (let ((vao (make-instance 'vao :type 'vertex-color))) 145 | (vao-buffer-data vao 0 (* 4 VERTEX-FLOAT-COUNT) POINTER-TO-VERTEX-FLOATS) 146 | (vao-buffer-data vao 1 (* 4 COLOR-FLOAT-COUNT) POINTER-TO-COLOR-FLOATS) 147 | 148 | ;; Establish more stuff here.. active shaders, uniforms, etc, then: 149 | (vao-draw vao :count VERTEX-COUNT)) 150 | ``` 151 | 152 | **This requires a valid, active GL context,** just like other GL 153 | functions. `DEFVAO` does not, but everything else, *including the 154 | `make-instance`*, does. 155 | 156 | Alternatively, you can use `VAO-BUFFER-VECTOR` (and `VAO-BUFFER-SUB-VECTOR`), and supply a vector of `:element-type 'single-float` or `:element-type 'double-float` instead of a pointer. This is only available if your implementation supports *static-vectors* (most do). This is for convenience; managing the data yourself can reduce copying and consing considerably. 157 | 158 | Note the numbers above require you fill in a few specific things: 159 | 160 | * `vao-buffer-data` (and the `-sub` variant) take the *total byte count*. So for a `:float` attribute with 3 members, that's `(* 4 3 COUNT)`. 161 | * `vao-buffer-vector` (and the `-sub` variant) do not require you to supply the *total byte count*, as it can be guessed. You can however supply this information manually, by means of the keyword argument `:byte-size`. 162 | * `vao-buffer-*` also takes the *VBO index* rather than an attribute name, because an attribute might not have a unique VBO. See [Layouts](#Layouts) below. 163 | * `vao-draw` takes the *vertex* count; e.g., triangles have 3 vertices, and if you have 10 triangles, that's 30 vertices. 164 | 165 | The pointer data you must supply pre-formatted. However, for separate 166 | VBOs, this is reasonably easy to accomplish with something like 167 | [static-vectors](https://github.com/sionescu/static-vectors), or you can use the less-efficient `-vector` variants which do this for you. 168 | 169 | ### Dictionary 170 | 171 | * `defvao NAME OPTIONS &body GROUPS`
Define a VAO called `NAME`. Currently, there are no options. See below for group definition. 172 | * `vao-buffer-data VAO VBO BYTE-COUNT POINTER &optional (USAGE :dynamic-draw)`
Copy data to the VBO specified. The VBO is specified as a number. `BYTE-COUNT` is the total number of bytes to be copied. `POINTER` is a (foreign) pointer to the data. `USAGE` may be any valid usage constant for `glBufferData`. 173 | * `vao-buffer-sub-data VAO VBO OFFSET BYTE-COUNT POINTER`
The `glBufferSubData` variant. 174 | * `vao-buffer-vector VAO VBO VECTOR &key BYTE-SIZE (USAGE :dynamic-draw)`
Copy data to the VBO specified. The VBO is specified as a number. `BYTE-COUNT` is the total number of bytes to be copied, and is optional (this can be guessed from the array contents). `POINTER` is a (foreign) pointer to the data. `USAGE` may be any valid usage constant for `glBufferData`. `VECTOR` must be a vector of specializable type for *static-vectors*. Calling this will produce an error if *static-vectors* is not supported. 175 | * `vao-buffer-sub-vector VAO VBO OFFSET VECTOR &key BYTE-SIZE`
The `glBufferSubData` variant. 176 | * `vao-bind VAO`
Bind the VAO. This is not necessary for calling the provided VAO functions, since the VAO is bound automatically. However, it may be useful to ensure the VAO is bound if you wish to make GL calls manually. 177 | * `vao-unbind`
Unbind the current-bound VAO. Not done automatically. 178 | * `vao-draw VAO &key primitive (first 0) count`
Bind the VAO and call `glDrawArrays`. `count` is optional only if the vertex count has been supplied to the VAO, e.g. during `make-instance`. `primitive` defaults to triangles, but may be specified explicitly here, overriding the VAO's configuration. 179 | 180 | ### Layouts 181 | 182 | There are three layout types: 183 | 184 | * `:separate`: This uses a separate VBO for each attribute supplied. 185 | * `:interleave`: This uses a single VBO for all attributes specified, and *interleaves* the attributes, e.g.: `Vert0 Color0 Vert1 Color1 ...`, where each attribute (such as "Vert0") has `:count` values. 186 | * `:block`: This uses a single VBO for each attribute specified, arranged in *blocks*, e.g.: `Vert0 Vert1 Vert2 ... Color0 Color1 Color2 ...`. This *requires* you specify `:vertex-count` up front to `make-instance`. **This is currently not fully implemented.** 187 | 188 | You may specify one or more groups to a VAO definition: 189 | 190 | ```lisp 191 | (defvao NAME 192 | (:separate () ...) 193 | (:separate () ...) 194 | (:interleave () ...) 195 | ...) 196 | ``` 197 | 198 | You must be aware of the underlying VBO layout to the extent that you 199 | must specify the correct index to `vao-buffer-data`. In the future, 200 | you will be able to specify a valid symbolic name, though this may not 201 | be as efficient. 202 | 203 | You may also specify a `:divisor` option to the *group*, which 204 | corresponds to the DIVISOR parameter to `glVertexAttribDivisor`, 205 | allowing one attribute for multiple vertices. Note that because this 206 | is *per-group*, if you wish to have separate divisors per attribute, 207 | they must be in separate groups. 208 | -------------------------------------------------------------------------------- /examples/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :defpackage-plus-1) 2 | 3 | ;; KIT.GL.TEST 4 | 5 | (defpackage+ :kit.gl.test 6 | (:use #:cl #:alexandria #:kit.sdl2 #:kit.gl #:kit.gl.vao #:kit.gl.shader) 7 | (:export-only #:vaos #:vao-shader-330 #:vao-shader-150 #:vao-shader-120 8 | #:vao-shader-410)) 9 | -------------------------------------------------------------------------------- /examples/vao-shader-120.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Run: (kit.gl.test:vao-shader-120) 3 | ;;; 4 | ;;; This reuses everything from `vao-shader.lisp` except the shader 5 | ;;; dictionary. 6 | ;;; 7 | ;;; Use this if your card only supports GL 2.1 / GLSL 1.20 and has the 8 | ;;; ARB_vertex_array_object extension. 9 | 10 | (in-package :kit.gl.test) 11 | 12 | ;;; Now the shaders to use it 13 | (defdict vao-color.programs.120 () 14 | (program (:vertex-color 15 | :uniforms (:view-m) 16 | :attrs ((:vertex 0) 17 | (:color 1))) 18 | (:vertex-shader " 19 | #version 120 20 | 21 | uniform mat4 view_m; 22 | 23 | attribute vec2 vertex; 24 | attribute vec3 color; 25 | 26 | varying vec3 f_color; 27 | 28 | void main() { 29 | gl_Position = view_m * vec4(vertex, 0.0, 1.0); 30 | f_color = color; 31 | } 32 | ") 33 | (:fragment-shader " 34 | #version 120 35 | 36 | varying vec3 f_color; 37 | 38 | void main() { 39 | gl_FragColor = vec4(f_color, 1.0); 40 | } 41 | "))) 42 | 43 | (defun vao-shader-120 () 44 | (kit.sdl2:start) 45 | (sdl2:in-main-thread () 46 | (sdl2:gl-set-attr :context-major-version 2) 47 | (sdl2:gl-set-attr :context-minor-version 1) 48 | (sdl2:gl-set-attr :context-profile-mask 1)) 49 | (make-instance 'vao-shader-window :shaders 'vao-color.programs.120)) 50 | 51 | ;; (kit.gl.test:vao-shader-120) 52 | -------------------------------------------------------------------------------- /examples/vao-shader-150.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Run: (kit.gl.test:vao-shader-150) 3 | ;;; 4 | ;;; This reuses everything from `vao-shader.lisp` except the shader 5 | ;;; dictionary. 6 | ;;; 7 | ;;; Use this if your card only supports GL 3.2 / GLSL 1.50 8 | 9 | (in-package :kit.gl.test) 10 | 11 | ;;; Now the shaders to use it 12 | (defdict vao-color.programs.150 () 13 | (program (:vertex-color 14 | :uniforms (:view-m) 15 | :attrs ((:vertex 0) 16 | (:color 1))) 17 | (:vertex-shader " 18 | #version 150 19 | 20 | uniform mat4 view_m; 21 | 22 | in vec2 vertex; 23 | in vec3 color; 24 | 25 | smooth out vec3 f_color; 26 | 27 | void main() { 28 | gl_Position = view_m * vec4(vertex, 0.0, 1.0); 29 | f_color = color; 30 | } 31 | ") 32 | (:fragment-shader " 33 | #version 150 34 | 35 | in vec3 f_color; 36 | out vec4 f_out; 37 | 38 | void main() { 39 | f_out = vec4(f_color, 1.0); 40 | } 41 | "))) 42 | 43 | (defun vao-shader-150 () 44 | (kit.sdl2:start) 45 | (sdl2:in-main-thread () 46 | (sdl2:gl-set-attr :context-major-version 3) 47 | (sdl2:gl-set-attr :context-minor-version 2) 48 | (sdl2:gl-set-attr :context-profile-mask 1)) 49 | (make-instance 'vao-shader-window :shaders 'vao-color.programs.150)) 50 | 51 | ;; (kit.gl.test:vao-shader-150) 52 | -------------------------------------------------------------------------------- /examples/vao-shader-330.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Run: (kit.gl.test:vao-shader-330) 3 | ;;; 4 | ;;; Use this if your card supports GL 3.3 / GLSL 3.30 5 | 6 | (in-package :kit.gl.test) 7 | 8 | (defdict vao-color.programs.330 () 9 | (program :vertex-color (:view-m) 10 | (:vertex-shader " 11 | #version 330 12 | 13 | uniform mat4 view_m; 14 | 15 | layout (location = 0) in vec2 vertex; 16 | layout (location = 1) in vec3 color; 17 | 18 | smooth out vec3 f_color; 19 | 20 | void main() { 21 | gl_Position = view_m * vec4(vertex, 0.0, 1.0); 22 | f_color = color; 23 | } 24 | ") 25 | (:fragment-shader " 26 | #version 330 27 | 28 | smooth in vec3 f_color; 29 | out vec4 f_out; 30 | 31 | void main() { 32 | f_out = vec4(f_color, 1.0); 33 | } 34 | "))) 35 | 36 | (defun vao-shader-330 () 37 | (kit.sdl2:start) 38 | (sdl2:in-main-thread () 39 | (sdl2:gl-set-attr :context-major-version 3) 40 | (sdl2:gl-set-attr :context-minor-version 3) 41 | (sdl2:gl-set-attr :context-profile-mask 1)) 42 | (make-instance 'vao-shader-window :shaders 'vao-color.programs.330)) 43 | 44 | ;; (kit.gl.test:vao-shader-330) 45 | -------------------------------------------------------------------------------- /examples/vao-shader-410.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Run: (kit.gl.test:vao-shader-330) 3 | ;;; 4 | ;;; Use this if your card supports GL 4.1 / GLSL 4.10 5 | 6 | (in-package :kit.gl.test) 7 | 8 | (defdict vao-color.programs.410 () 9 | (program :vertex-color (:view-m) 10 | (:vertex-shader " 11 | #version 410 12 | 13 | uniform mat4 view_m; 14 | 15 | layout (location = 0) in vec2 vertex; 16 | layout (location = 1) in vec3 color; 17 | 18 | smooth out vec3 f_color; 19 | 20 | void main() { 21 | gl_Position = view_m * vec4(vertex, 0.0, 1.0); 22 | f_color = color; 23 | } 24 | ") 25 | (:fragment-shader " 26 | #version 410 27 | 28 | smooth in vec3 f_color; 29 | out vec4 f_out; 30 | 31 | void main() { 32 | f_out = vec4(f_color, 1.0); 33 | } 34 | "))) 35 | 36 | (defun vao-shader-410 () 37 | (kit.sdl2:start) 38 | (sdl2:in-main-thread () 39 | (sdl2:gl-set-attr :context-major-version 4) 40 | (sdl2:gl-set-attr :context-minor-version 1) 41 | (sdl2:gl-set-attr :context-profile-mask 1)) 42 | (make-instance 'vao-shader-window :shaders 'vao-color.programs.410)) 43 | 44 | ;; (kit.gl.test:vao-shader-410) 45 | -------------------------------------------------------------------------------- /examples/vao-shader-window.lisp: -------------------------------------------------------------------------------- 1 | ;;; This uses VAOs and shaders. Actual shaders are in separate files, 2 | ;;; by version. Run the function most appropriate to your GL version: 3 | ;;; 4 | ;;; (kit.gl.test:vao-shader-330) ; GL 3.3 5 | ;;; (kit.gl.test:vao-shader-150) ; GL 3.2 6 | ;;; (kit.gl.test:vao-shader-120) ; GL 2.1 7 | ;;; 8 | ;;; Note that VAOs are technically only core as of 3.0, and your 9 | ;;; driver may not support them otherwise unless you have 10 | ;;; the ARB_vertex_array_object extension. 11 | 12 | (in-package :kit.gl.test) 13 | 14 | ;;; We'll reuse the verts from `vaos.lisp` 15 | 16 | ;;; The colors: 17 | (defparameter *vao-colors* 18 | (make-array 9 19 | :element-type 'single-float 20 | :initial-contents #(1.0 0.0 0.0 21 | 0.0 1.0 0.0 22 | 0.0 0.0 1.0))) 23 | 24 | ;;; Define the layout of the VAO 25 | (defvao vertex-color-2d () 26 | (:separate () 27 | (vertex :float 2) 28 | (color :float 3))) 29 | 30 | (defclass vao-shader-window (kit.sdl2.test:test-window) 31 | ((view-matrix :initform (kit.glm:ortho-matrix -2 2 -2 2 -2 2)) 32 | (vao :initform nil) 33 | (programs :initform nil))) 34 | 35 | (defmethod initialize-instance :after ((w vao-shader-window) 36 | &key shaders &allow-other-keys) 37 | (setf (idle-render w) t) 38 | (gl:viewport 0 0 800 600) 39 | 40 | (with-slots (vao programs) w 41 | ;; Compile shaders using the dictionary name specified via :shaders 42 | (setf programs (compile-shader-dictionary shaders)) 43 | 44 | ;; Make the VAO, and copy the data into it. 45 | (setf vao (make-instance 'vao 46 | :type 'vertex-color-2d 47 | :primitive :triangles 48 | :vertex-count (/ (length *vao-verts*) 2))) 49 | (vao-buffer-vector vao 0 *vao-verts*) 50 | (vao-buffer-vector vao 1 *vao-colors*))) 51 | 52 | (defmethod render ((window vao-shader-window)) 53 | (with-slots (view-matrix vao programs) window 54 | (gl:clear-color 0.0 0.0 1.0 1.0) 55 | (gl:clear :color-buffer) 56 | 57 | ;; Now we just tell GL to draw the contents: 58 | (use-program programs :vertex-color) 59 | (uniform-matrix programs :view-m 4 (vector view-matrix)) 60 | (vao-draw vao))) 61 | 62 | ;; (kit.gl.test:vao-shader-330) 63 | -------------------------------------------------------------------------------- /examples/vaos.lisp: -------------------------------------------------------------------------------- 1 | ;;; This is based on the sdl2kit example; you must load that first! 2 | ;;; 3 | ;;; Run: (kit.gl.test:vaos) 4 | ;;; 5 | 6 | (in-package :kit.gl.test) 7 | 8 | ;;; Using a specific :element-type is necessary for VAO-BUFFER-VECTOR 9 | (defparameter *vao-verts* 10 | (make-array 6 11 | :element-type 'single-float 12 | :initial-contents #(0.0 1.0 13 | -1.0 -1.0 14 | 1.0 -1.0))) 15 | 16 | ;;; Define the layout of the VAO 17 | (defvao vertex-2d () 18 | (:separate () 19 | (vertex :float 2))) 20 | 21 | (defclass vao-window (kit.sdl2.test:test-window) 22 | ((vao :initform nil))) 23 | 24 | (defmethod initialize-instance :after ((w vao-window) &key &allow-other-keys) 25 | (setf (idle-render w) t) 26 | (gl:viewport 0 0 800 600) 27 | (gl:matrix-mode :projection) 28 | (gl:ortho -2 2 -2 2 -2 2) 29 | (gl:matrix-mode :modelview) 30 | (gl:load-identity) 31 | 32 | (with-slots (vao) w 33 | ;; Make the VAO, and copy the data into it. 34 | (setf vao (make-instance 'vao 35 | :type 'vertex-2d 36 | :primitive :triangles 37 | :vertex-count (/ (length *vao-verts*) 2))) 38 | (vao-buffer-vector vao 0 *vao-verts*))) 39 | 40 | (defmethod render ((window vao-window)) 41 | (with-slots (vao rotation) window 42 | (gl:load-identity) 43 | (gl:clear-color 0.0 0.0 1.0 1.0) 44 | (gl:clear :color-buffer) 45 | (gl:color 1.0 0.0 0.0) 46 | ;; Now we just tell GL to draw the contents: 47 | (vao-draw vao))) 48 | 49 | (defun vaos () 50 | (kit.sdl2:start) 51 | (make-instance 'vao-window)) 52 | 53 | ;;; (vaos) 54 | -------------------------------------------------------------------------------- /glkit-examples.asd: -------------------------------------------------------------------------------- 1 | (defpackage :glkit.asdf 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package :glkit.asdf) 5 | 6 | (defsystem :glkit-examples 7 | :description "Various utilities for OpenGL" 8 | :author ("rpav") 9 | :license "MIT" 10 | :version "0.0" 11 | 12 | :depends-on (:sdl2kit-examples :glkit) 13 | :pathname "examples" 14 | :serial t 15 | 16 | :components 17 | ((:file "package") 18 | (:file "vaos") 19 | (:file "vao-shader-window") 20 | (:file "vao-shader-410") 21 | (:file "vao-shader-330") 22 | (:file "vao-shader-150") 23 | (:file "vao-shader-120"))) 24 | -------------------------------------------------------------------------------- /glkit.asd: -------------------------------------------------------------------------------- 1 | (defpackage :glkit.asdf 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package :glkit.asdf) 5 | 6 | #+(or allegro ccl cmu ecl lispworks sbcl) 7 | (eval-when (:compile-toplevel :load-toplevel :execute) 8 | (pushnew :glkit-sv *features*)) 9 | 10 | (defsystem :glkit 11 | :description "Various utilities for OpenGL" 12 | :author ("rpav") 13 | :license "MIT" 14 | :version "0.0" 15 | 16 | :depends-on (:alexandria :defpackage-plus :sb-cga :mathkit 17 | :cl-opengl #+glkit-sv :static-vectors) 18 | :pathname "src" 19 | :serial t 20 | 21 | :components 22 | ((:file "package") 23 | (:file "protocol") 24 | 25 | (:module "shader-dict" 26 | :serial t 27 | :pathname "shader-dict" 28 | :components 29 | ((:file "shaders") 30 | (:file "uniforms") 31 | (:file "macros"))) 32 | 33 | (:module "vao" 34 | :serial t 35 | :pathname "vao" 36 | :components 37 | ((:file "vao"))) 38 | 39 | (:module "tex" 40 | :serial t 41 | :pathname "tex" 42 | :components 43 | ((:file "util") 44 | (:file "texture") 45 | (:file "fbo"))))) 46 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :defpackage-plus-1) 2 | 3 | (defpackage+ :kit.gl 4 | (:use #:cl) 5 | (:export-only 6 | ;; Utility 7 | #:gl-delete 8 | 9 | ;; Protocol 10 | #:gl-delete-object)) 11 | 12 | ;; KIT.GL.SHADER 13 | 14 | (defpackage+ :kit.gl.shader 15 | (:use #:cl #:alexandria #:kit.gl) 16 | (:export-only 17 | 18 | #:compile-and-check-shader 19 | #:compile-and-link-program 20 | #:program #:shader-dictionary 21 | #:find-program #:find-uniform 22 | #:compile-shader-dictionary 23 | #:use-program 24 | #:uniformi #:uniformf #:uniformfv #:uniform-matrix 25 | #:uniform-matrix-1-sv 26 | #:missing-uniform-error #:without-missing-uniform-errors 27 | 28 | #:defdict #:dict #:find-dictionary #:define-dictionary 29 | #:program #:shader 30 | 31 | #:parse-shader-source #:parse-shader-source-complex)) 32 | 33 | ;; KIT.GL.VAO 34 | 35 | (defpackage+ :kit.gl.vao 36 | (:use #:cl #:kit.gl) 37 | (:export-only 38 | #:defvao 39 | #:vao #:vao-buffer-data #:vao-buffer-sub-data 40 | #:vao-indexed 41 | #:vao-buffer-vector #:vao-buffer-sub-vector 42 | #:vao-bind #:vao-unbind 43 | #:vao-draw #:vao-draw-instanced 44 | #:vao-draw-elements #:vao-draw-elements-instanced 45 | 46 | ;; deprecated 47 | #:vao-indexed-draw)) 48 | 49 | ;; KIT.GLM 50 | 51 | (defpackage+ :kit.glm 52 | (:use #:cl) 53 | (:inherit #:sb-cga #:kit.math)) 54 | 55 | ;; KIT.GL.TEX 56 | 57 | (defpackage+ :kit.gl.tex 58 | (:use #:cl #:kit.gl) 59 | (:export-only 60 | 61 | ;; TEXTURE 62 | #:texture #:texture-id 63 | #:texture-size 64 | #:texture-width #:texture-height #:texture-depth 65 | #:texture-target 66 | #:tex-bind #:tex-unbind #:tex-parameters 67 | #:tex-image-1d #:tex-image-2d #:tex-image-3d 68 | 69 | #:active-texture 70 | 71 | ;; FBO 72 | #:framebuffer #:framebuffer-id #:framebuffer-target 73 | #:fbo-bind #:fbo-unbind 74 | #:fbo-texture #:fbo-texture-1d #:fbo-texture-2d #:fbo-texture-3d 75 | #:fbo-renderbuffer 76 | 77 | ;; RENDERBUFFER 78 | #:renderbuffer #:renderbuffer-id 79 | )) 80 | -------------------------------------------------------------------------------- /src/protocol.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl) 2 | 3 | ;;; Protocol for everyone 4 | 5 | (defgeneric gl-delete-object (gl-object) 6 | (:documentation "Call the appropriate gl* function to free the resource 7 | `GL-OBJECT`.")) 8 | 9 | (defmethod gl-delete-object ((gl-objects list)) 10 | (map nil #'gl-delete-object gl-objects)) 11 | 12 | (defmethod gl-delete-object ((gl-objects vector)) 13 | (map nil #'gl-delete-object gl-objects)) 14 | 15 | (defun gl-delete (&rest gl-objects) 16 | "Delete `GL-OBJECTS` by calling `GL-DELETE-OBJECT` on each." 17 | (map nil #'gl-delete-object gl-objects)) 18 | -------------------------------------------------------------------------------- /src/shader-dict/macros.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.shader) 2 | 3 | ;; SHADER-DICTIONARIES 4 | 5 | (defvar *shader-dictionaries* (make-hash-table)) 6 | 7 | (defun find-dictionary (name) 8 | (or (gethash name *shader-dictionaries*) 9 | (error "Shader dictionary not found: ~S" name))) 10 | 11 | (defun define-dictionary (name programs &key (path *default-pathname-defaults*) 12 | shaders) 13 | (setf (gethash name *shader-dictionaries*) 14 | (make-instance 'shader-dictionary-definition 15 | :name name 16 | :path path 17 | :shaders shaders 18 | :programs programs))) 19 | 20 | (defmacro dict (name) 21 | `(find-dictionary ',name)) 22 | 23 | ;; PARSE-SHADER-SOURCE 24 | 25 | (defgeneric parse-shader-source (source shader-type shader-list) 26 | (:documentation "Specialize on `SOURCE` and return a string. 27 | `SHADER-TYPE` is the type (e.g., `:fragment-shader`). Specializations 28 | are predefined for *string*, *list*, and *symbol*; do not redefine 29 | these. 30 | 31 | `SHADER-LIST` is an optional ALIST of existing \"named\" shader 32 | definitions in the form `(NAME . (TYPE VALUE))`. Note that `VALUE` 33 | may not be a string, and `PARSE-SHADER-SOURCE` must be called 34 | recursively to resolve it.")) 35 | 36 | (defgeneric parse-shader-source-complex (key params shader-type shader-list) 37 | (:documentation "Much like `PARSE-SHADER-SOURCE`, except called when 38 | the source is a list. In this case, `KEY` is the car of that list, 39 | `PARAMS` is the cdr, and `SHADER-TYPE` and `SHADER-LIST` are as per 40 | `PARSE-SHADER-SOURCE`.")) 41 | 42 | (defmethod parse-shader-source ((source string) shader-type shader-list) 43 | (declare (ignore shader-type shader-list)) 44 | source) 45 | 46 | (defmethod parse-shader-source ((source list) shader-type shader-list) 47 | (parse-shader-source-complex (car source) (cdr source) shader-type shader-list)) 48 | 49 | (defmethod parse-shader-source ((source symbol) shader-type shader-list) 50 | (declare (ignore shader-type)) 51 | (let ((shader (assoc source shader-list))) 52 | (if shader 53 | (parse-shader-source (caddr shader) (cadr shader) shader-list) 54 | (error "Shader not found: ~S" source)))) 55 | 56 | (defmethod parse-shader-source-complex ((key (eql :file)) params shader-type shader-list) 57 | (declare (ignore shader-type shader-list)) 58 | (read-file-into-string (car params))) 59 | 60 | ;; DEFDICT 61 | 62 | (defmacro defdict (name (&key shader-path (uniform-style :underscore)) &body options) 63 | (let ((shaders) (programs)) 64 | (loop for option in options 65 | do (alexandria:switch ((car option) :test 'equalp 66 | :key 'symbol-name) 67 | ("shader" 68 | (destructuring-bind (name type value) (cdr option) 69 | (push (list name type value) shaders))) 70 | ("program" 71 | (destructuring-bind (&rest options) (cdr option) 72 | (if (listp (car options)) 73 | (destructuring-bind ((name &key attrs uniforms) 74 | &rest shaders) 75 | options 76 | (push `(make-instance 'program-source 77 | :name ',name 78 | :uniform-style ',uniform-style 79 | :uniforms ',uniforms 80 | :attrs ',attrs 81 | :shaders ',shaders) 82 | programs)) 83 | (destructuring-bind (name uniform-list &rest shaders) 84 | options 85 | (push `(make-instance 'program-source 86 | :name ',name 87 | :uniform-style ',uniform-style 88 | :uniforms ',uniform-list 89 | :shaders ',shaders) 90 | programs))))))) 91 | `(define-dictionary ',name (list ,@programs) 92 | :path (or ,shader-path 93 | *default-pathname-defaults*) 94 | :shaders ',shaders))) 95 | -------------------------------------------------------------------------------- /src/shader-dict/shaders.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.shader) 2 | 3 | ;; Classes 4 | 5 | (defclass shader-dictionary-definition () 6 | ((name :initarg :name) 7 | (path :initform *default-pathname-defaults* :initarg :path) 8 | (shaders :initarg :shaders) 9 | (programs :initarg :programs))) 10 | 11 | (defclass program-source () 12 | ((name :initarg :name) 13 | (shaders :initarg :shaders) 14 | (vertex-attributes :initarg :attrs :initform nil) 15 | (uniform-style :initarg :uniform-style) 16 | (uniforms :initarg :uniforms))) 17 | 18 | (defclass program () 19 | ((name :initform nil :initarg :name) 20 | (id :initform nil) 21 | (uniforms :initform (make-hash-table :test 'equal)))) 22 | 23 | (defclass compiled-shader-dictionary () 24 | ((programs :initform (make-hash-table)) 25 | (active-program :initform nil))) 26 | 27 | ;; Functions 28 | 29 | (defun compile-and-check-shader (shader source) 30 | (gl:shader-source shader source) 31 | (gl:compile-shader shader) 32 | (unless (gl:get-shader shader :compile-status) 33 | (gl:get-shader-info-log shader))) 34 | 35 | (defun compile-and-link-program (attrs &rest shaders) 36 | "(compile-and-link-program :vertex-shader STRING :fragment-shader STRING ...)" 37 | (let (compiled-shaders) 38 | (loop for type in shaders by #'cddr 39 | for text in (cdr shaders) by #'cddr 40 | do (let ((shader (gl:create-shader type))) 41 | (when-let ((log (compile-and-check-shader shader text))) 42 | (error "Compile Log for ~A:~%~A~%" type log)) 43 | (push shader compiled-shaders))) 44 | (let ((program (gl:create-program))) 45 | (if (= 0 program) 46 | (progn 47 | (loop for shader in compiled-shaders 48 | do (gl:delete-shader shader)) 49 | (error "Error creating program: ~A" 50 | (gl:get-error))) 51 | (progn 52 | (loop for shader in compiled-shaders 53 | do (gl:attach-shader program shader)) 54 | (loop for attr in attrs 55 | as name = (if (symbolp (car attr)) 56 | (string-downcase (string (car attr))) 57 | (car attr)) 58 | as index = (cadr attr) 59 | do (handler-case 60 | (gl:bind-attrib-location program index name) 61 | (gl:opengl-error (e) 62 | (error "Error binding attribute ~S:~%~A" 63 | name e)))) 64 | (gl:link-program program) 65 | (unless (gl:get-program program :link-status) 66 | (error "Link Log:~%~A~%" (gl:get-program-info-log program))) 67 | (loop for shader in compiled-shaders 68 | do (gl:detach-shader program shader) 69 | (gl:delete-shader shader)))) 70 | program))) 71 | 72 | (defmethod print-object ((o program-source) stream) 73 | (with-slots (name) o 74 | (print-unreadable-object (o stream :type t) 75 | (format stream "~S" name)))) 76 | 77 | (defun process-source (dict source program) 78 | (let ((shaders 79 | (let ((*default-pathname-defaults* 80 | (slot-value dict 'path))) 81 | (loop with other-shaders = (slot-value dict 'shaders) 82 | for shader-source in (slot-value source 'shaders) 83 | as type = (car shader-source) 84 | collect type 85 | collect 86 | (parse-shader-source (cadr shader-source) 87 | type 88 | other-shaders))))) 89 | (let ((p (apply #'compile-and-link-program 90 | (slot-value source 'vertex-attributes) shaders))) 91 | (gl:use-program p) 92 | (with-slots (id uniforms) program 93 | (setf id p) 94 | (with-slots (uniform-style (source-uniforms uniforms)) source 95 | (loop for uniform in source-uniforms 96 | as symbol = (if (symbolp uniform) uniform (car uniform)) 97 | as name = (if (or (symbolp uniform) 98 | (not (cadr uniform))) 99 | (symbol-to-uniform uniform-style uniform) 100 | (cadr uniform)) 101 | as loc = (gl:get-uniform-location id name) 102 | do (setf (gethash symbol uniforms) loc))))))) 103 | 104 | (defmethod symbol-to-uniform ((uniform-style (eql :underscore)) symbol) 105 | (substitute #\_ #\- (string-downcase (symbol-name symbol)))) 106 | 107 | (defmethod symbol-to-uniform ((uniform-style (eql :camel-case)) symbol) 108 | (let ((result (string-downcase (symbol-name symbol)))) 109 | (loop :for char :across result 110 | :for i :from 0 111 | :when (char= char #\-) 112 | :do (setf (elt result (1+ i)) (char-upcase (elt result (1+ i))) 113 | result (remove char result :count 1)) 114 | (decf i)) 115 | result)) 116 | 117 | (defun find-program (dictionary name) 118 | (with-slots (programs) dictionary 119 | (gethash name programs))) 120 | 121 | (defun find-uniform (dictionary program name) 122 | (with-slots (id uniforms) (find-program dictionary program) 123 | (if (stringp name) 124 | (gl:get-uniform-location id name) 125 | (gethash name uniforms)))) 126 | 127 | (defgeneric compile-shader-dictionary (source)) 128 | 129 | (defmethod compile-shader-dictionary ((sources shader-dictionary-definition)) 130 | "Input is a list of PROGRAM-SOURCE objects. Returns a new 131 | COMPILED-SHADER-DICTIONARY object. This must be called with a valid, active 132 | GL-CONTEXT. The result is only valid while that GL-CONTEXT is valid." 133 | (let ((sd (make-instance 'compiled-shader-dictionary))) 134 | (with-slots (path shaders (source programs)) sources 135 | (with-slots ((compiled-programs programs)) sd 136 | (loop for program-source in source 137 | as name = (slot-value program-source 'name) 138 | as program = (make-instance 'program :name name) 139 | do (setf (gethash name compiled-programs) program) 140 | (process-source sources program-source program)))) 141 | (gl:use-program 0) 142 | sd)) 143 | 144 | (defmethod compile-shader-dictionary ((source symbol)) 145 | (compile-shader-dictionary (find-dictionary source))) 146 | 147 | (defun use-program (dict program) 148 | "Set program named `PROGRAM` in `DICT` as the active program. 149 | `PROGRAM` may be 0 or NIL, in which case, this has the same effect as 150 | calling (gl:use-program 0). In this case, it is valid to pass `NIL` 151 | for `DICT`." 152 | (with-slots (active-program) dict 153 | (if (or (null program) 154 | (and (numberp program) (= 0 program))) 155 | (progn 156 | (when dict 157 | (setf active-program nil)) 158 | (gl:use-program 0)) 159 | (let ((p (find-program dict program))) 160 | (unless p 161 | (error "Program not found in dictionary: ~S" program)) 162 | (with-slots (id) p 163 | (setf active-program p) 164 | (gl:use-program id)))))) 165 | 166 | (defmethod gl-delete-object ((d compiled-shader-dictionary)) 167 | (with-slots (programs) d 168 | (apply #'gl-delete (alexandria:hash-table-values programs)))) 169 | 170 | (defmethod gl-delete-object ((p program)) 171 | (with-slots (id) p 172 | (%gl:delete-program id))) 173 | -------------------------------------------------------------------------------- /src/shader-dict/uniforms.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.shader) 2 | 3 | 4 | (define-condition missing-uniform-error (simple-error) 5 | ((name :reader name :initarg :name)) 6 | (:report (lambda (c s) 7 | (format s "Uniform not found: ~S" (name c))))) 8 | 9 | (defmacro without-missing-uniform-errors ((&key print) &body body) 10 | (with-gensyms (seen e) 11 | `(let ((,seen (make-hash-table :test #'equal))) 12 | (handler-bind 13 | ((missing-uniform-error 14 | (lambda (,e) 15 | ,@(when print 16 | `((when (and ,print (not (gethash (name ,e) ,seen))) 17 | (format t "Uniform not found: ~s~%" (name ,e)) 18 | (setf (gethash (name ,e) ,seen) t)))) 19 | (invoke-restart 'continue)))) 20 | ,@body)))) 21 | 22 | 23 | (defmacro with-uniform-location ((var name) dict &body body) 24 | (once-only (name) 25 | `(with-slots (active-program) ,dict 26 | (with-slots (uniforms) active-program 27 | (let ((,var (if (symbolp ,name) 28 | (gethash ,name uniforms) 29 | (with-slots (id) active-program 30 | (gl:get-uniform-location id ,name))))) 31 | (unless (and ,var (or (>= ,var -1))) 32 | (cerror "Continue" 'missing-uniform-error :name name) 33 | (setf ,var -1)) 34 | ,@body))))) 35 | 36 | (declaim (inline uniformi uniformf uniformfv uniform-matrix)) 37 | (defun uniformi (dict name x &optional y z w) 38 | "Set the value for uniform with name `NAME` in the 39 | active program (set by sdk2.kit:use-program)." 40 | (with-uniform-location (u name) dict 41 | (cond 42 | (w (%gl:uniform-4i u x y z w)) 43 | (z (%gl:uniform-3i u x y z)) 44 | (y (%gl:uniform-2i u x y)) 45 | (x (%gl:uniform-1i u x))))) 46 | 47 | (defun uniformf (dict name x &optional y z w) 48 | "Set the value for uniform with name `NAME` in the 49 | active program (set by sdk2.kit:use-program)." 50 | (with-uniform-location (u name) dict 51 | (cond 52 | (w (%gl:uniform-4f u x y z w)) 53 | (z (%gl:uniform-3f u x y z)) 54 | (y (%gl:uniform-2f u x y)) 55 | (x (%gl:uniform-1f u x))))) 56 | 57 | (defun uniformfv (dict name a) 58 | (with-uniform-location (u name) dict 59 | (gl:uniformfv u a))) 60 | 61 | (defun uniform-matrix (dict name dim matrices &optional (transpose nil)) 62 | (with-uniform-location (u name) dict 63 | (gl:uniform-matrix u dim matrices transpose))) 64 | 65 | (defun uniform-matrix-1-sv (dict name matrix &optional (transpose nil)) 66 | (declare (type kit.glm:matrix matrix)) 67 | #+glkit-sv 68 | (let* ((sv (static-vectors:make-static-vector 16 69 | :element-type 'single-float 70 | :initial-contents matrix)) 71 | (ptr (static-vectors:static-vector-pointer sv))) 72 | (with-uniform-location (u name) dict 73 | (%gl:uniform-matrix-4fv u 1 transpose ptr)) 74 | (static-vectors:free-static-vector sv)) 75 | #-glkit-sv 76 | (error "STATIC-VECTORS not supported by your implementation.")) 77 | -------------------------------------------------------------------------------- /src/tex/fbo.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.tex) 2 | 3 | ;; FRAMEBUFFER 4 | 5 | (defclass framebuffer () 6 | ((id :initform (car (gl:gen-framebuffers 1)) :initarg :id :accessor framebuffer-id) 7 | (target :initform :framebuffer :initarg :target :accessor framebuffer-target))) 8 | 9 | (defmethod initialize-instance :after ((fbo framebuffer) &key &allow-other-keys) 10 | (with-slots (id target) fbo 11 | (when (and id target) (fbo-bind fbo)))) 12 | 13 | (defmethod gl-delete-object ((fbo framebuffer)) 14 | (with-slots (id) fbo 15 | (gl:delete-framebuffers (list id)))) 16 | 17 | (defun fbo-bind (fbo &optional target) 18 | (with-slots (id) fbo 19 | (with-slot-values-override (target) fbo 20 | (%gl:bind-framebuffer target id)))) 21 | 22 | (defun fbo-unbind (fbo-or-target) 23 | (let ((target (etypecase fbo-or-target 24 | (keyword fbo-or-target) 25 | (framebuffer (framebuffer-target fbo-or-target))))) 26 | (%gl:bind-framebuffer target 0))) 27 | 28 | (defun fbo-texture (fbo attachment texture &key target (level 0)) 29 | (let ((texture (etypecase texture 30 | (texture (texture-id texture)) 31 | (integer texture)))) 32 | (with-slot-values-override (target) fbo 33 | (%gl:framebuffer-texture target attachment texture level)))) 34 | 35 | (defun fbo-texture-1d (fbo attachment texture &key textarget target (level 0)) 36 | (let ((texture-id (etypecase texture 37 | (texture (texture-id texture)) 38 | (integer texture)))) 39 | (with-slot-values-override (target) fbo 40 | (with-slot-values-override ((textarget target)) texture 41 | (%gl:framebuffer-texture-1d target attachment textarget texture-id level))))) 42 | 43 | (defun fbo-texture-2d (fbo attachment texture &key textarget target (level 0)) 44 | (let ((texture-id (etypecase texture 45 | (texture (texture-id texture)) 46 | (integer texture)))) 47 | (with-slot-values-override (target) fbo 48 | (with-slot-values-override ((textarget target)) texture 49 | (%gl:framebuffer-texture-2d target attachment textarget texture-id level))))) 50 | 51 | (defun fbo-texture-3d (fbo attachment texture layer 52 | &key textarget target (level 0)) 53 | (let ((texture-id (etypecase texture 54 | (texture (texture-id texture)) 55 | (integer texture)))) 56 | (with-slot-values-override (target) fbo 57 | (with-slot-values-override ((textarget target)) texture 58 | (%gl:framebuffer-texture-3d target attachment textarget texture-id 59 | level layer))))) 60 | 61 | (defun fbo-renderbuffer (fbo attachment renderbuffer &key target) 62 | (with-slots ((renderbuffer-id id)) renderbuffer 63 | (with-slot-values-override (target) fbo 64 | (%gl:framebuffer-renderbuffer target attachment :renderbuffer renderbuffer-id)))) 65 | 66 | ;; RENDERBUFFER 67 | 68 | (defclass renderbuffer () 69 | ((id :initform (car (gl:gen-renderbuffers 1)) :initarg :id :accessor renderbuffer-id))) 70 | 71 | (defmethod initialize-instance :after ((rbo renderbuffer) 72 | &key (width 1024) (height 1024) (samples 0) 73 | (internal-format :rgba) 74 | &allow-other-keys) 75 | (with-slots (id) rbo 76 | (gl:bind-renderbuffer :renderbuffer id) 77 | (%gl:renderbuffer-storage-multisample 78 | :renderbuffer samples internal-format width height))) 79 | 80 | (defmethod gl-delete-object ((rbo renderbuffer)) 81 | (with-slots (id) rbo 82 | (gl:delete-renderbuffers (list id)))) 83 | -------------------------------------------------------------------------------- /src/tex/texture.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.tex) 2 | 3 | (defclass texture () 4 | ((id :initform (car (gl:gen-textures 1)) :initarg :id :accessor texture-id) 5 | (target :initform :texture-2d :initarg :target :accessor texture-target) 6 | (size :initarg :size 7 | :initform (kit.glm:vec3 0.0 0.0 0.0) 8 | :accessor texture-size :type kit.glm:vec3))) 9 | 10 | (defgeneric texture-width (tex) 11 | (:method ((tex texture)) (with-slots (size) tex (aref size 0)))) 12 | (defgeneric texture-height (tex) 13 | (:method ((tex texture)) (with-slots (size) tex (aref size 1)))) 14 | (defgeneric texture-depth (tex) 15 | (:method ((tex texture)) (with-slots (size) tex (aref size 2)))) 16 | 17 | (defgeneric tex-parameters (tex &key &allow-other-keys) 18 | (:documentation "Set texture parameters for `TEX`, bound to 19 | `TARGET`, where valid, or do nothing. `TEX` must be bound prior to calling. 20 | Note that creating a texture causes it to become bound.")) 21 | 22 | (defmethod initialize-instance :after ((tex texture) 23 | &key 24 | (mag :linear) (min :linear) 25 | (wrap-s :repeat) (wrap-t :repeat) 26 | &allow-other-keys) 27 | (with-slots (id target) tex 28 | (when (and id target) 29 | (tex-bind tex) 30 | (tex-parameters tex :mag mag :min min :wrap-s wrap-s :wrap-t wrap-t)))) 31 | 32 | (defun active-texture (num &optional (unit :texture0)) 33 | (let ((texture0 (cffi:foreign-enum-value '%gl:enum unit))) 34 | (%gl:active-texture (+ texture0 num)))) 35 | 36 | (defun tex-bind (tex &optional target) 37 | (let ((target (or target (slot-value tex 'target)))) 38 | (with-slots (id) tex 39 | (gl:bind-texture target id)))) 40 | 41 | (defun tex-unbind (tex-or-target) 42 | (let ((target (etypecase tex-or-target 43 | (keyword tex-or-target) 44 | (texture (texture-target tex-or-target))))) 45 | (gl:bind-texture target 0))) 46 | 47 | (defmethod tex-parameters ((tex texture) &key mag min wrap-s wrap-t) 48 | (with-slots (target) tex 49 | (when mag (gl:tex-parameter target :texture-mag-filter mag)) 50 | (when min (gl:tex-parameter target :texture-min-filter min)) 51 | (when wrap-s (gl:tex-parameter target :texture-wrap-s wrap-s)) 52 | (when wrap-t (gl:tex-parameter target :texture-wrap-t wrap-t)))) 53 | 54 | (defmethod gl-delete-object ((tex texture)) 55 | (with-slots (id) tex 56 | (gl:delete-textures (list id)))) 57 | 58 | (define-tex-fun tex-image-1d (target size) 59 | ((border 0) (level 0) (internal-format :rgba) (format :rgba) 60 | (type :unsigned-int-8-8-8-8) data) 61 | (gl:tex-image-1d target level internal-format (aref size 0) border 62 | format type (or data (cffi-sys:null-pointer)))) 63 | 64 | (define-tex-fun tex-sub-image-1d (target) 65 | ((level 0) (xoffset 0) size (format :rgba) (type :unsigned-int-8-8-8-8) 66 | data) 67 | (gl:tex-sub-image-1d target level xoffset (aref size 0) format type 68 | (or data (cffi-sys:null-pointer)))) 69 | 70 | (define-tex-fun tex-image-2d (target size) 71 | ((border 0) (level 0) (internal-format :rgba) (format :rgba) 72 | (type :unsigned-int-8-8-8-8) data) 73 | (gl:tex-image-2d target level internal-format 74 | (aref size 0) (aref size 1) border 75 | format type (or data (cffi-sys:null-pointer)))) 76 | 77 | (define-tex-fun tex-sub-image-2d (target) 78 | ((level 0) (xoffset 0) (yoffset 0) size (format :rgba) 79 | (type :unsigned-int-8-8-8-8) data) 80 | (gl:tex-sub-image-2d target level xoffset yoffset 81 | (aref size 0) (aref size 1) 82 | format type (or data (cffi-sys:null-pointer)))) 83 | 84 | (define-tex-fun tex-image-2d-multisample (target size) 85 | (samples (internal-format :rgba) fixed-sample-locations) 86 | (%gl:tex-image-2d-multisample target samples internal-format 87 | (aref size 0) (aref size 1) 88 | fixed-sample-locations)) 89 | 90 | (define-tex-fun tex-image-3d (target size) 91 | ((border 0) (level 0) (internal-format :rgba) (format :rgba) 92 | (type :unsigned-int-8-8-8-8) data) 93 | (gl:tex-image-3d target level internal-format 94 | (aref size 0) (aref size 1) (aref size 2) border 95 | format type (or data (cffi-sys:null-pointer)))) 96 | 97 | (define-tex-fun tex-sub-image-3d (target) 98 | ((level 0) (xoffset 0) (yoffset 0) (zoffset 0) size 99 | (format :rgba) (type :unsigned-int-8-8-8-8) data) 100 | (gl:tex-sub-image-3d target level xoffset yoffset zoffset 101 | (aref size 0) (aref size 1) (aref size 2) 102 | format type (or data (cffi-sys:null-pointer)))) 103 | 104 | (define-tex-fun tex-image-3d-multisample (target size) 105 | (samples (internal-format :rgba) fixed-sample-locations) 106 | (%gl:tex-image-3d-multisample target samples internal-format 107 | (aref size 0) (aref size 1) (aref size 2) 108 | fixed-sample-locations)) 109 | -------------------------------------------------------------------------------- /src/tex/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.tex) 2 | 3 | (defmacro with-slot-values-override (slots instance &body body) 4 | (alexandria:once-only (instance) 5 | `(let (,@(loop for slot in slots 6 | collect 7 | (cond 8 | ((symbolp slot) 9 | `(,slot (or ,slot (slot-value ,instance ',slot)))) 10 | ((listp slot) 11 | `(,(car slot) (or ,(car slot) (slot-value ,instance ',(cadr slot)))))))) 12 | ,@body))) 13 | 14 | (defmacro define-tex-fun (name slot-overrides other-keys &body body) 15 | `(defun ,name ,(concatenate 'list 16 | (list 'texture '&key) 17 | slot-overrides 18 | other-keys) 19 | (with-slots (id) texture 20 | (with-slot-values-override ,slot-overrides texture 21 | ,@body)))) 22 | -------------------------------------------------------------------------------- /src/vao/vao.lisp: -------------------------------------------------------------------------------- 1 | (in-package :kit.gl.vao) 2 | 3 | (defvar *vao-declarations* (make-hash-table)) 4 | 5 | ;; GFs 6 | 7 | (defgeneric vao-add (vao object)) 8 | 9 | (defgeneric vao-attr-count (vao) 10 | (:documentation "Number of slots for `VAO`.")) 11 | 12 | (defgeneric vao-vbo-count (group) 13 | (:documentation "Number of VBOs allocated by `GROUP`.")) 14 | 15 | (defgeneric vao-set-pointers (group starting-index total-vertices vbos) 16 | (:documentation "Use glVertexAttribPointer and related to define the 17 | attributes. `VBOS` is a vector of `VAO-VBO-COUNT` VBOs. It is 18 | necessary to bind each of these as appropriate. It is not necessary 19 | to call `gl:enable-vertex-attrib-array`. 20 | 21 | `STARTING-INDEX` is the starting vertex attribute index for this group. 22 | 23 | `TOTAL-VERTICES` is the known vertex count, or `NIL` if it is 24 | unknown.")) 25 | 26 | (defgeneric attribute-size (attr) 27 | (:documentation "Total size in bytes of `ATTR`.")) 28 | 29 | (defmethod attribute-size ((attr symbol)) 30 | (ecase attr 31 | ((:byte :unsigned-byte) 1) 32 | ((:short :unsigned-short :half-float) 2) 33 | ((:float :int :unsigned-int) 4) 34 | (:double 8))) 35 | 36 | ;; VAO declaration 37 | 38 | (defun vao-find (name) 39 | (gethash name *vao-declarations*)) 40 | 41 | (defclass vertex-attribute () 42 | ((name :initarg :name :reader vertex-attribute-name) 43 | (type :initarg :type) 44 | (out-type :initarg :out-type) 45 | (count :initarg :count) 46 | (normalizep :initarg :normalizep))) 47 | 48 | (defun attribute-set-pointer (attr index stride offset divisor) 49 | (with-slots (type out-type count normalizep) attr 50 | (ecase out-type 51 | ((:byte :unsigned-byte :short :unsigned-short :int :unsigned-int) 52 | (%gl:vertex-attrib-ipointer index count type stride offset)) 53 | ((:float :half-float) 54 | (%gl:vertex-attrib-pointer index count type 55 | (if normalizep 1 0) 56 | stride offset)) 57 | (:double 58 | (%gl:vertex-attrib-lpointer index count type stride offset))) 59 | (when divisor 60 | (%gl:vertex-attrib-divisor index divisor)))) 61 | 62 | (defclass vertex-attribute-group () 63 | ((divisor :initform 0 :initarg :divisor) 64 | (attributes :initform (make-array 0 :adjustable t :fill-pointer 0)))) 65 | 66 | (defclass vertex-interleave-group (vertex-attribute-group) ()) 67 | (defclass vertex-block-group (vertex-attribute-group) ()) 68 | (defclass vertex-separate-group (vertex-attribute-group) ()) 69 | 70 | (defmethod print-object ((o vertex-attribute-group) stream) 71 | (with-slots (attributes) o 72 | (print-unreadable-object (o stream :type t) 73 | (format stream "~S" (map 'list #'vertex-attribute-name attributes))))) 74 | 75 | (defclass vao-declaration () 76 | ((attr-index :initform (make-hash-table)) 77 | (attr-count :initform 0) 78 | (groups :initform (make-array 0 :adjustable t :fill-pointer 0)))) 79 | 80 | (defun vao-decl-add-index (decl attr) 81 | (with-slots (attr-index attr-count) decl 82 | (setf (gethash (vertex-attribute-name attr) attr-index) attr-count) 83 | (incf attr-count))) 84 | 85 | ;;; VAO-ADD 86 | (defmethod vao-add (vao object) 87 | (error "You may not add ~% ~S~% to~% ~S" object vao)) 88 | 89 | (defmethod vao-add ((vao vao-declaration) (group vertex-attribute-group)) 90 | (with-slots (groups) vao 91 | (vector-push-extend group groups))) 92 | 93 | (defmethod vao-add ((group vertex-attribute-group) (attr vertex-attribute)) 94 | (with-slots (attributes) group 95 | (vector-push-extend attr attributes))) 96 | 97 | (defmethod vao-add ((group vertex-block-group) (ig vertex-interleave-group)) 98 | (with-slots (attributes) group 99 | (vector-push-extend ig attributes))) 100 | 101 | (defmethod vao-add ((group vertex-attribute-group) (sg vertex-separate-group)) 102 | (with-slots (attributes) group 103 | (vector-push-extend sg attributes))) 104 | 105 | ;;; ATTR/VBO counts 106 | (defmethod vao-attr-count ((attr vertex-attribute)) 1) 107 | 108 | (defmethod vao-attr-count ((group vertex-attribute-group)) 109 | (with-slots (attributes) group 110 | (reduce #'+ (map 'list #'vao-attr-count attributes)))) 111 | 112 | (defmethod vao-attr-count ((vao vao-declaration)) 113 | (with-slots (groups) vao 114 | (reduce #'+ (map 'list #'vao-attr-count groups)))) 115 | 116 | (defmethod vao-vbo-count ((attr vertex-attribute)) 1) 117 | (defmethod vao-vbo-count ((group vertex-interleave-group)) 1) 118 | (defmethod vao-vbo-count ((group vertex-block-group)) 1) 119 | (defmethod vao-vbo-count ((group vertex-separate-group)) 120 | (with-slots (attributes) group 121 | (reduce #'+ (map 'list #'vao-vbo-count attributes)))) 122 | 123 | (defmethod vao-vbo-count ((vao vao-declaration)) 124 | (with-slots (groups) vao 125 | (reduce #'+ (map 'list #'vao-vbo-count groups)))) 126 | 127 | ;;; ATTRIBUTE-SIZE 128 | 129 | (defmethod attribute-size ((attr vertex-attribute)) 130 | (with-slots (type count) attr 131 | (* (attribute-size type) count))) 132 | 133 | (defmethod attribute-size ((group vertex-interleave-group)) 134 | (with-slots (attributes divisor) group 135 | (loop for attr across attributes 136 | summing (attribute-size attr) into size 137 | finally (return size)))) 138 | 139 | (defmethod attribute-size ((group vertex-separate-group)) 140 | (with-slots (attributes divisor) group 141 | (loop for attr across attributes 142 | summing (attribute-size attr) into size 143 | finally (return size)))) 144 | 145 | ;;; VAO-SET-POINTERS 146 | (defmethod vao-set-pointers ((group vertex-interleave-group) starting-index 147 | vertex-count vbos) 148 | (declare (ignore vertex-count)) 149 | (let ((stride (attribute-size group)) 150 | (offset 0)) 151 | (with-slots (attributes divisor) group 152 | (%gl:bind-buffer :array-buffer (aref vbos 0)) 153 | (loop for attr across attributes 154 | for i from starting-index 155 | do (attribute-set-pointer attr i stride offset divisor) 156 | (incf offset (attribute-size attr)))))) 157 | 158 | (defmethod vao-set-pointers ((group vertex-separate-group) starting-index 159 | vertex-count vbos) 160 | (declare (ignore vertex-count)) 161 | (with-slots (attributes divisor) group 162 | (loop for attr across attributes 163 | for attr-index from starting-index 164 | for vbo-index from 0 165 | do (gl:bind-buffer :array-buffer (aref vbos vbo-index)) 166 | (attribute-set-pointer attr attr-index 0 0 divisor)))) 167 | 168 | (defmethod vao-set-pointers ((group vertex-block-group) starting-index 169 | vertex-count vbos) 170 | (error "Implement VAO-SET-POINTERS for block groups")) 171 | 172 | ;; Parsing 173 | 174 | (defvar *vao-decl* nil) 175 | 176 | (defun vao-parse (list) 177 | ;; The distinction between a group decl and a vertex-attribute decl 178 | ;; is whether the second argument is an option list (which may be 179 | ;; NIL). 180 | (if (listp (cadr list)) 181 | (vao-parse-group (vao-parse-make-group (car list) (cadr list)) 182 | (cddr list)) 183 | (apply #'vao-parse-decl list))) 184 | 185 | ;;; VERTEX-ATTRIBUTE parsing 186 | 187 | (defun vao-parse-decl (name type count &key out-type normalizep) 188 | (let ((attr (make-instance 'vertex-attribute 189 | :name name 190 | :type type 191 | :count count 192 | :out-type (or out-type type) 193 | :normalizep normalizep))) 194 | (vao-decl-add-index *vao-decl* attr) 195 | attr)) 196 | 197 | ;;; VERTEX-ATTRIBUTE-GROUP parsing 198 | 199 | (defgeneric vao-parse-make-group (type options)) 200 | (defgeneric vao-parse-group (group body)) 201 | 202 | (defmethod vao-parse-make-group ((type (eql :interleave)) options) 203 | (apply #'make-instance 'vertex-interleave-group options)) 204 | 205 | (defmethod vao-parse-make-group ((type (eql :blocks)) options) 206 | (apply #'make-instance 'vertex-block-group options)) 207 | 208 | (defmethod vao-parse-make-group ((type (eql :separate)) options) 209 | (apply #'make-instance 'vertex-separate-group options)) 210 | 211 | (defmethod vao-parse-group ((group vertex-attribute-group) body) 212 | (loop for i in body 213 | do (vao-add group (vao-parse i))) 214 | group) 215 | 216 | ;; DEFVAO 217 | 218 | (defmacro defvao (name options &body groups) 219 | (declare (ignore options)) 220 | `(eval-when (:compile-toplevel :load-toplevel :execute) 221 | (let ((*vao-decl* (make-instance 'vao-declaration))) 222 | (map 'nil (lambda (x) 223 | (vao-add *vao-decl* (vao-parse x))) 224 | ',groups) 225 | (setf (gethash ',name *vao-declarations*) *vao-decl*)))) 226 | 227 | ;; vao 228 | 229 | (defclass vao () 230 | ((type :type vao-declaration) 231 | (id :initform (gl:gen-vertex-array)) 232 | (vbos) 233 | (vertex-count :initform nil :initarg :vertex-count) 234 | (pointers :initform nil) 235 | (primitive :initarg :primitive :initform nil))) 236 | 237 | (defclass vao-indexed (vao) 238 | ((index :initarg :index))) 239 | 240 | (defmethod initialize-instance :after ((vao vao) &key type &allow-other-keys) 241 | (vao-bind vao) 242 | (with-slots ((vao-type type) id vbos vertex-count) vao 243 | (if type 244 | (setf vao-type (vao-find type)) 245 | (error "No :TYPE specified for VAO.")) 246 | (let ((vbo-count (vao-vbo-count vao-type))) 247 | (setf vbos (make-array vbo-count 248 | :initial-contents (gl:gen-buffers vbo-count)))) 249 | (with-slots (groups) vao-type 250 | (loop for group across groups 251 | as vbo-offset = 0 then (+ vbo-offset vbo-count) 252 | as vbo-count = (vao-vbo-count group) 253 | as vbo-subset = (make-array vbo-count :displaced-to vbos 254 | :displaced-index-offset vbo-offset) 255 | as attr-offset = 0 then (+ attr-offset attr-count) 256 | as attr-count = (vao-attr-count group) 257 | do (loop for i from 0 below (vao-attr-count group) 258 | do (%gl:enable-vertex-attrib-array (+ i attr-offset))) 259 | (vao-set-pointers group attr-offset vertex-count vbo-subset))))) 260 | 261 | (defmethod vao-attr-count ((vao vao)) 262 | (with-slots (type) vao 263 | (vao-attr-count type))) 264 | 265 | ;; vao activation 266 | 267 | (defun vao-bind (vao) 268 | (with-slots (id) vao 269 | (%gl:bind-vertex-array id))) 270 | 271 | (defun vao-unbind () 272 | (%gl:bind-vertex-array 0)) 273 | 274 | ;; buffer-data 275 | 276 | (defun guess-buffer-size (array) 277 | (let* ((count (length array)) 278 | (type-size 279 | (etypecase array 280 | ((simple-array single-float *) 4) 281 | ((simple-array double-float *) 8) 282 | ((simple-array (signed-byte 8) *) 1) 283 | ((simple-array (unsigned-byte 8) *) 1) 284 | ((simple-array (signed-byte 16) *) 2) 285 | ((simple-array (unsigned-byte 16) *) 2) 286 | ((simple-array (signed-byte 32) *) 4) 287 | ((simple-array (unsigned-byte 32) *) 4)))) 288 | (* count type-size))) 289 | 290 | (defun vao-buffer-vector (vao vbo vector &key byte-size (usage :dynamic-draw)) 291 | #+glkit-sv 292 | (with-slots (type vbos) vao 293 | (with-slots (attr-index) type 294 | (let* ((sv (static-vectors:make-static-vector 295 | (length vector) 296 | :element-type (array-element-type vector) 297 | :initial-contents vector)) 298 | (ptr (static-vectors:static-vector-pointer sv)) 299 | (byte-size (or byte-size (guess-buffer-size vector)))) 300 | (%gl:bind-buffer :array-buffer (aref vbos vbo)) 301 | (%gl:buffer-data :array-buffer byte-size ptr usage) 302 | (static-vectors:free-static-vector sv)))) 303 | #-glkit-sv 304 | (error "STATIC-VECTORS not supported by your implementation.")) 305 | 306 | (defun vao-buffer-data (vao vbo byte-size pointer &optional (usage :dynamic-draw)) 307 | (with-slots (type vbos) vao 308 | (with-slots (attr-index) type 309 | (%gl:bind-buffer :array-buffer (aref vbos vbo)) 310 | (%gl:buffer-data :array-buffer byte-size pointer usage)))) 311 | 312 | (defun vao-buffer-sub-vector (vao vbo offset vector &key byte-size) 313 | #+glkit-sv 314 | (with-slots (type vbos) vao 315 | (with-slots (attr-index) type 316 | (let* ((sv (static-vectors:make-static-vector 317 | (length vector) 318 | :element-type (array-element-type vector) 319 | :initial-contents vector)) 320 | (ptr (static-vectors:static-vector-pointer sv)) 321 | (byte-size (or byte-size (guess-buffer-size vector)))) 322 | (%gl:bind-buffer :array-buffer (aref vbos vbo)) 323 | (%gl:buffer-sub-data :array-buffer offset byte-size ptr) 324 | (static-vectors:free-static-vector sv)))) 325 | #-glkit-sv 326 | (error "STATIC-VECTORS not supported by your implementation.")) 327 | 328 | (defun vao-buffer-sub-data (vao vbo offset byte-size pointer) 329 | (with-slots (type vbos) vao 330 | (with-slots (attr-index) type 331 | (%gl:bind-buffer :array-buffer (aref vbos vbo)) 332 | (%gl:buffer-sub-data :array-buffer offset byte-size pointer)))) 333 | 334 | ;; draw 335 | 336 | (defun vao-draw (vao &key primitive (first 0) count) 337 | (with-slots ((prim primitive) vertex-count) vao 338 | (vao-bind vao) 339 | (%gl:draw-arrays (or primitive prim) first (or count vertex-count)))) 340 | 341 | (defun vao-draw-instanced (vao prim-count &key primitive (first 0) count) 342 | (with-slots ((prim primitive) vertex-count) vao 343 | (vao-bind vao) 344 | (%gl:draw-arrays-instanced (or primitive prim) first (or count vertex-count) prim-count))) 345 | 346 | (defun vao-draw-elements (vao &key primitive index count type) 347 | (with-slots ((prim primitive) (ind index) vertex-count) vao 348 | (vao-bind vao) 349 | (%gl:draw-elements (or primitive prim) 350 | (or count vertex-count) 351 | type 352 | (or index ind)))) 353 | 354 | (defun vao-draw-elements-instanced (vao prim-count &key primitive index count type) 355 | (with-slots ((prim primitive) (ind index) vertex-count) vao 356 | (vao-bind vao) 357 | (%gl:draw-elements-instanced (or primitive prim) 358 | (or count vertex-count) 359 | type 360 | (or index ind) 361 | prim-count))) 362 | 363 | 364 | (defmacro vao-indexed-draw (vao &key primitive index) 365 | (warn "VAO-INDEXED-DRAW deprecated, use VAO-DRAW-ELEMENTS") 366 | `(vao-draw-elements ,vao :primitive ,primitive :index ,index)) 367 | 368 | 369 | ;; delete 370 | 371 | (defmethod gl-delete-object ((vao vao)) 372 | (with-slots (vbos id) vao 373 | (gl:delete-buffers vbos) 374 | (gl:delete-vertex-arrays (list id)))) 375 | --------------------------------------------------------------------------------