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 ;; 2.0 conveniences
  71
  72 (defun shader-source-from-stream (handle in)
  73   (declare (type stream in))
  74   (let* ((lines (loop for line = (read-line in nil) while line collecting line))
  75          (c-lines (cffi:foreign-alloc :string :initial-contents lines)))
  76     (gl:shader-source handle (length lines) c-lines (cffi:null-pointer))))
  77
  78 (defun check-compiled-shader (handle)
  79   "Given a shader handle that has been compiled, checks and flags in a lisp-friendly manner
  80 their compile status. Errors are signalled using an error with the shader log, success will
  81 just warn with the contents of the program-log, if present."
  82   (cffi:with-foreign-objects ((log-length 'gl:sizei)
  83                               (compile-status 'gl:int))
  84     (gl:get-shader-iv handle gl:+info-log-length+ log-length)
  85     (gl:get-shader-iv handle gl:+compile-status+ compile-status)
  86     (let ((shader-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
  87                         (cffi:with-foreign-pointer-as-string (str 4096)
  88                           (gl:get-shader-info-log handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
  89                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
  90       (if (= (cffi:mem-ref compile-status 'gl:int)
  91              gl:+true+)
  92           (when shader-log (warn shader-log))
  93           (error shader-log)))))
  94
  95 (defun make-shader (type source)
  96   "Convenience function to create a shader of type given from source, which may either be a
  97 pathname of a file to load from, or a string of the shader source directly. Returns handle of the new shader."
  98   (let ((handle (gl:create-shader type)))
  99     (if (typep source 'pathname)
 100         (with-open-file (in source :direction :input)
 101           (shader-source-from-stream handle in))
 102         (with-input-from-string (in source)
 103           (shader-source-from-stream handle in)))
 104     (gl:compile-shader handle)
 105     (check-compiled-shader handle)
 106     handle))
 107
 108 (defun check-linked-program (handle)
 109   "Given a program handle that has been linked, checks and flags in a lisp-friendly manner
 110 their link status. Errors are signalled using an error with the program log, success will
 111 just warn with the contents of the program-log, if present."
 112   (cffi:with-foreign-objects ((log-length 'gl:sizei)
 113                               (link-status 'gl:int))
 114     (gl:get-program-iv handle gl:+info-log-length+ log-length)
 115     (gl:get-program-iv handle gl:+link-status+ link-status)
 116     (let ((program-log (when (> (cffi:mem-ref log-length 'gl:sizei) 1)
 117                         (cffi:with-foreign-pointer-as-string (str 4096)
 118                           (gl:get-program-info-log handle (cffi:mem-ref log-length 'gl:sizei) (cffi:null-pointer) str)
 119                           (cffi:foreign-string-to-lisp str (cffi:mem-ref log-length 'gl:sizei))))))
 120       (if (= (cffi:mem-ref link-status 'gl:int)
 121              gl:+true+)
 122           (when program-log (warn program-log))
 123           (error program-log)))))
 124
 125 (defun make-program (&rest shader-handles)
 126   "Given shader handles, creates a program, attaches any shaders given and links the program."
 127   (let ((handle (gl:create-program)))
 128     (dolist (shader-handle shader-handles)
 129       (gl:attach-shader handle shader-handle))
 130     (when shader-handles
 131       (gl:link-program handle)
 132       (check-linked-program handle))
 133     handle))
 134
 135 (defmacro with-use-program (name &body forms)
 136   "Executes forms using the shader program named. And cleanly use no-program afterwards."
 137   `(progn
 138      (gl:use-program ,name)
 139      (unwind-protect (progn ,@forms)
 140        (gl:use-program 0))))
 141
 142 (export '(with-new-list with-push-name with-begin with-push-attrib with-push-matrix with-setup-projection with-push-client-attrib with-begin-query with-map-buffer
 143           shader-source-from-stream check-compiled-shader make-shader
 144           check-linked-program make-program
 145           with-use-program))