3 (defmacro with-new-list
(list mode
&body forms
)
4 "New/End-List wrapper."
6 (gl:new-list
,list
,mode
)
7 (unwind-protect (progn ,@forms
)
10 (defmacro with-push-name
(name &body forms
)
11 "Select name push/pop wrapper"
14 (unwind-protect (progn ,@forms
)
17 (defmacro with-begin
(mode &body forms
)
18 "Immediate mode block wrapper."
21 (unwind-protect (progn ,@forms
)
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."
27 (gl:push-attrib
(logior ,@attrib-bits
))
28 (unwind-protect (progn ,@forms
)
31 (defmacro with-push-matrix
(&body forms
)
32 "Pushes the current matrix onto the stack, executes forms and clean up with pop-matrix."
35 (unwind-protect (progn ,@forms
)
38 (defmacro with-setup-projection
(&body forms
)
39 "Switch to projection mode, load identity, execute forms and return to modelview matrix mode."
41 (gl:matrix-mode gl
:+projection
+)
43 (unwind-protect (progn ,@forms
)
44 (gl:matrix-mode gl
:+modelview
+))))
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."
51 (gl:push-client-attrib
(logior ,@attrib-bits
))
52 (unwind-protect (progn ,@forms
)
53 (gl:pop-client-attrib
))))
56 (defmacro with-begin-query
((target id
) &body forms
)
58 (gl:begin-query
,target
,id
)
59 (unwind-protect (progn ,@forms
)
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
)))))
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
))))
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
)
92 (when shader-log
(warn shader-log
))
93 (error shader-log
)))))
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
)
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
)
122 (when program-log
(warn program-log
))
123 (error program-log
)))))
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
))
131 (gl:link-program handle
)
132 (check-linked-program handle
))
135 (defmacro with-use-program
(name &body forms
)
136 "Executes forms using the shader program named. And cleanly use no-program afterwards."
138 (gl:use-program
,name
)
139 (unwind-protect (progn ,@forms
)
140 (gl:use-program
0))))
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