lib/opengl-convenience.lisp

   1 (in-package #:opengl)
   2
   3 (defmacro with-new-list (list mode &body forms)
   4   "New/End-List wrapper."
   5   `(progn
   6      (gl:new-list ,list ,mode)
   7      (unwind-protect (progn ,@forms)
   8        (gl:end-list))))
   9
  10 (defmacro with-push-name (name &body forms)
  11   "Select name push/pop wrapper"
  12   `(progn
  13      (gl:push-name ,name)
  14      (unwind-protect (progn ,@forms)
  15        (gl:pop-name))))
  16
  17 (defmacro with-begin (mode &body forms)
  18   "Immediate mode block wrapper."
  19   `(progn
  20      (gl:begin ,mode)
  21      (unwind-protect (progn ,@forms)
  22        (gl:end))))
  23
  24 (defmacro with-push-attrib ((&rest attrib-bits) &body forms)
  25   "Pushes the bitwise or of attrib-bits, executing forms and clean up with pop-attrib."
  26   `(progn
  27      (gl:push-attrib (logior ,@attrib-bits))
  28      (unwind-protect (progn ,@forms)
  29        (gl:pop-attrib))))
  30
  31 (defmacro with-push-matrix (&body forms)
  32   "Pushes the current matrix onto the stack, executes forms and clean up with pop-matrix."
  33   `(progn
  34      (gl:push-matrix)
  35      (unwind-protect (progn ,@forms)
  36        (gl:pop-matrix))))
  37
  38 (defmacro with-setup-projection (&body forms)
  39   "Switch to projection mode, load identity, execute forms and return to modelview matrix mode."
  40   `(progn
  41      (gl:matrix-mode gl:+projection+)
  42      (gl:load-identity)
  43      (unwind-protect (progn ,@forms)
  44        (gl:matrix-mode gl:+modelview+))))
  45
  46 ;; 1.1 Conveniences
  47
  48 (defmacro with-push-client-attrib ((&rest attrib-bits) &body forms)
  49   "Pushes the bitwise or of the client attrib-bits, executing forms and clean up with pop-client-attrib."
  50   `(progn
  51      (gl:push-client-attrib (logior ,@attrib-bits))
  52      (unwind-protect (progn ,@forms)
  53        (gl:pop-client-attrib))))
  54
  55 ;; 1.5 Conveniences
  56 (defmacro with-begin-query ((target id) &body forms)
  57   `(progn
  58      (gl:begin-query ,target ,id)
  59      (unwind-protect (progn ,@forms)
  60        (gl:end-query))))
  61
  62 (defmacro with-map-buffer ((target access) &body forms)
  63   "Executes forms with VBO buffer mapped as with gl:map-buffer, unmapping cleanly afterwards."
  64   (let ((ntarget (gensym "TARGET-")))
  65     `(let ((,ntarget ,target))
  66        (gl:map-buffer ,ntarget ,access)
  67        (unwind-protect (progn ,@forms)
  68          (gl:unmap-buffer ,ntarget)))))
  69
  70 (defmacro with-bind-buffer ((target buffer) &body forms)
  71   "Executes forms with the VBO buffer bound with gl:bind-buffer, cleanly restoring to previous state afterwards."
  72   (let ((ntarget (gensym "TARGET-"))
  73         (saved-buffer-v (gensym "SAVED-BUFFER-V-")))
  74     `(let ((,ntarget ,target))
  75        (cffi:with-foreign-object (,saved-buffer-v 'gl:int)
  76          (cond
  77            ((eql ,ntarget gl:+array-buffer+)         (gl:get-integerv gl:+array-buffer-binding+ ,saved-buffer-v))
  78            ((eql ,ntarget gl:+element-array-buffer+) (gl:get-integerv gl:+element-array-buffer-binding+ ,saved-buffer-v))
  79            ((eql ,ntarget gl:+pixel-pack-buffer+)    (gl:get-integerv gl:+pixel-pack-buffer-binding+ ,saved-buffer-v))
  80            ((eql ,ntarget gl:+pixel-unpack-buffer+)  (gl:get-integerv gl:+pixel-unpack-buffer-binding+ ,saved-buffer-v)))
  81          (gl:bind-buffer ,ntarget ,buffer)
  82          (unwind-protect (progn ,@forms)
  83            (gl:bind-buffer ,ntarget (cffi:mem-ref ,saved-buffer-v 'gl:int)))))))
  84
  85 ;; ARB_vertex_buffer_object
  86
  87 (defmacro with-map-buffer-arb ((target access) &body forms)
  88   "Executes forms with VBO buffer mapped as with gl:map-buffer-arb, unmapping cleanly afterwards."
  89   (let ((ntarget (gensym "TARGET-")))
  90     `(let ((,ntarget ,target))
  91        (gl:map-buffer-arb ,ntarget ,access)
  92        (unwind-protect (progn ,@forms)
  93          (gl:unmap-buffer-arb ,ntarget)))))
  94
  95 (defmacro with-bind-buffer-arb ((target buffer) &body forms)
  96   "Executes forms with the VBO buffer bound with gl:bind-buffer-arb, cleanly restoring to previous state afterwards."
  97   (let ((ntarget (gensym "TARGET-"))
  98         (saved-buffer-v (gensym "SAVED-BUFFER-V-")))
  99     `(let ((,ntarget ,target))
 100        (cffi:with-foreign-object (,saved-buffer-v 'gl:int)
 101          (cond
 102            ((eql ,ntarget gl:+array-buffer-arb+)         (gl:get-integerv gl:+array-buffer-binding-arb+ ,saved-buffer-v))
 103            ((eql ,ntarget gl:+element-array-buffer-arb+) (gl:get-integerv gl:+element-array-buffer-binding-arb+ ,saved-buffer-v))
 104            ((eql ,ntarget gl:+pixel-pack-buffer-arb+)    (gl:get-integerv gl:+pixel-pack-buffer-binding-arb+ ,saved-buffer-v))
 105            ((eql ,ntarget gl:+pixel-unpack-buffer-arb+)  (gl:get-integerv gl:+pixel-unpack-buffer-binding-arb+ ,saved-buffer-v)))
 106          (gl:bind-buffer-arb ,ntarget ,buffer)
 107          (unwind-protect (progn ,@forms)
 108            (gl:bind-buffer-arb ,ntarget (cffi:mem-ref ,saved-buffer-v 'gl:int)))))))
 109
 110
 111 ;; ARB_shader_objects, ARB_vertex_shader and ARB_fragment_shader conveniences
 112
 113 (defun shader-source-from-stream-arb (handle in)
 114   (declare (type stream in))
 115   (let* ((lines (loop for line = (read-line in nil) while line collecting line))
 116          (c-lines (cffi:foreign-alloc :string :initial-contents lines)))
 117     (gl:shader-source-arb handle (length lines) c-lines (cffi:null-pointer))))
 118
 119 (defun check-compiled-shader-arb (handle)
 120   "Given a shader handle that has been compiled, checks and flags in a lisp-friendly manner
 121 their compile status. Errors are signalled using an error with the shader log, success will
 122 just warn with the contents of the program-log, if present."
 123   (cffi:with-foreign-objects ((log-length 'gl:sizei)
 124                               (compile-status 'gl:int))
 125     (gl:get-object-parameter-iv-arb handle gl:+object-info-log-length-arb+ log-length)
 126     (gl:get-object-parameter-iv-arb handle gl:+object-compile-status-arb+ compile-status)
 127     (let ((shader-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
 128                         (cffi:with-foreign-pointer-as-string (str 4096)
 129                           (gl:get-info-log-arb handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
 130                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
 131       (if (= (cffi:mem-ref compile-status 'gl:int)
 132              gl:+true+)
 133           (when shader-log (warn shader-log))
 134           (error shader-log)))))
 135
 136 (defun make-shader-arb (type source)
 137   "Convenience function to create a shader of type given from source, which may either be a
 138 pathname of a file to load from, or a string of the shader source directly. Returns handle of the new shader."
 139   (let ((handle (gl:create-shader-object-arb type)))
 140     (if (typep source 'pathname)
 141         (with-open-file (in source :direction :input)
 142           (shader-source-from-stream-arb handle in))
 143         (with-input-from-string (in source)
 144           (shader-source-from-stream-arb handle in)))
 145     (gl:compile-shader-arb handle)
 146     (check-compiled-shader-arb handle)
 147     handle))
 148
 149 (defun check-linked-program-arb (handle)
 150   "Given a program handle that has been linked, checks and flags in a lisp-friendly manner
 151 their link status. Errors are signalled using an error with the program log, success will
 152 just warn with the contents of the program-log, if present."
 153   (cffi:with-foreign-objects ((log-length 'gl:sizei)
 154                               (link-status 'gl:int))
 155     (gl:get-object-parameter-iv-arb handle gl:+object-info-log-length-arb+ log-length)
 156     (gl:get-object-parameter-iv-arb handle gl:+object-link-status-arb+ link-status)
 157     (let ((program-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
 158                         (cffi:with-foreign-pointer-as-string (str 4096)
 159                           (gl:get-info-log-arb handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
 160                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
 161       (if (= (cffi:mem-ref link-status 'gl:int)
 162              gl:+true+)
 163           (when program-log (warn program-log))
 164           (error program-log)))))
 165
 166 (defun make-program-arb (&rest shader-handles)
 167   "Given shader handles, creates a program, attaches any shaders given and links the program."
 168   (let ((handle (gl:create-program-object-arb)))
 169     (dolist (shader-handle shader-handles)
 170       (gl:attach-object-arb handle shader-handle))
 171     (when shader-handles
 172       (gl:link-program-arb handle)
 173       (check-linked-program-arb handle))
 174     handle))
 175
 176 (defmacro with-use-program-arb (name &body forms)
 177   "Executes forms using the shader program named. And cleanly use no-program afterwards."
 178   `(progn
 179      (cffi:with-foreign-object (current-program-v 'gl:handle)
 180        (gl:get-handle-arb gl:+program-object-arb+ current-program-v)
 181        (gl:use-program-object-arb ,name)
 182        (unwind-protect (progn ,@forms)
 183          (gl:use-program-object-arb (cffi:mem-ref current-program-v 'gl:int))))))
 184
 185 ;; 2.0 conveniences
 186
 187 (defun shader-source-from-stream (handle in)
 188   (declare (type stream in))
 189   (let* ((lines (loop for line = (read-line in nil) while line collecting line))
 190          (c-lines (cffi:foreign-alloc :string :initial-contents lines)))
 191     (gl:shader-source handle (length lines) c-lines (cffi:null-pointer))))
 192
 193 (defun check-compiled-shader (handle)
 194   "Given a shader handle that has been compiled, checks and flags in a lisp-friendly manner
 195 their compile status. Errors are signalled using an error with the shader log, success will
 196 just warn with the contents of the program-log, if present."
 197   (cffi:with-foreign-objects ((log-length 'gl:sizei)
 198                               (compile-status 'gl:int))
 199     (gl:get-shader-iv handle gl:+info-log-length+ log-length)
 200     (gl:get-shader-iv handle gl:+compile-status+ compile-status)
 201     (let ((shader-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
 202                         (cffi:with-foreign-pointer-as-string (str 4096)
 203                           (gl:get-shader-info-log handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
 204                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
 205       (if (= (cffi:mem-ref compile-status 'gl:int)
 206              gl:+true+)
 207           (when shader-log (warn shader-log))
 208           (error shader-log)))))
 209
 210 (defun make-shader (type source)
 211   "Convenience function to create a shader of type given from source, which may either be a
 212 pathname of a file to load from, or a string of the shader source directly. Returns handle of the new shader."
 213   (let ((handle (gl:create-shader type)))
 214     (if (typep source 'pathname)
 215         (with-open-file (in source :direction :input)
 216           (shader-source-from-stream handle in))
 217         (with-input-from-string (in source)
 218           (shader-source-from-stream handle in)))
 219     (gl:compile-shader handle)
 220     (check-compiled-shader handle)
 221     handle))
 222
 223 (defun check-linked-program (handle)
 224   "Given a program handle that has been linked, checks and flags in a lisp-friendly manner
 225 their link status. Errors are signalled using an error with the program log, success will
 226 just warn with the contents of the program-log, if present."
 227   (cffi:with-foreign-objects ((log-length 'gl:sizei)
 228                               (link-status 'gl:int))
 229     (gl:get-program-iv handle gl:+info-log-length+ log-length)
 230     (gl:get-program-iv handle gl:+link-status+ link-status)
 231     (let ((program-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
 232                         (cffi:with-foreign-pointer-as-string (str 4096)
 233                           (gl:get-program-info-log handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
 234                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
 235       (if (= (cffi:mem-ref link-status 'gl:int)
 236              gl:+true+)
 237           (when program-log (warn program-log))
 238           (error program-log)))))
 239
 240 (defun make-program (&rest shader-handles)
 241   "Given shader handles, creates a program, attaches any shaders given and links the program."
 242   (let ((handle (gl:create-program)))
 243     (dolist (shader-handle shader-handles)
 244       (gl:attach-shader handle shader-handle))
 245     (when shader-handles
 246       (gl:link-program handle)
 247       (check-linked-program handle))
 248     handle))
 249
 250 (defmacro with-use-program (name &body forms)
 251   "Executes forms using the shader program named. And cleanly use no-program afterwards."
 252   `(progn
 253      (cffi:with-foreign-object (current-program-v 'gl:int)
 254        (gl:get-integerv gl:+current-program+ current-program-v)
 255        (gl:use-program ,name)
 256        (unwind-protect (progn ,@forms)
 257          (gl:use-program (cffi:mem-ref current-program-v 'gl:int))))))
 258
 259 (export '(with-new-list with-push-name with-begin with-push-attrib with-push-matrix with-setup-projection
 260           ;; 1.1
 261           with-push-client-attrib
 262           ;; ARB_vertex_buffer_object
 263           with-map-buffer-arb with-bind-buffer-arb
 264           ;; 1.5
 265           with-begin-query
 266           with-map-buffer with-bind-buffer
 267           ;; ARB_vertex_shader/ARB_fragment_shader/ARB_shader_objects
 268           shader-source-from-stream-arb check-compiled-shader-arb make-shader-arb
 269           check-linked-program-arb make-program-arb
 270           with-use-program-arb
 271           ;; 2.0
 272           shader-source-from-stream check-compiled-shader make-shader
 273           check-linked-program make-program
 274           with-use-program
 275           ))