Permalink
Browse files

Minor improvements

  • Loading branch information...
Shinmera committed Jun 20, 2018
1 parent ffb68fe commit 357b7c847421da91967c59a1b470a7f179810c33
Showing with 21 additions and 4 deletions.
  1. +12 −4 resources/texture.lisp
  2. +4 −0 static-vector.lisp
  3. +5 −0 toolkit.lisp
View
@@ -89,13 +89,21 @@
(let ((tex (gl-name texture)))
(lambda () (when tex (gl:delete-textures (list tex))))))
(defun coerce-pixel-data (pixel-data)
(etypecase pixel-data
(null
(cffi:null-pointer))
(cffi:foreign-pointer
pixel-data)
((satisfies static-vector-p)
(static-vectors:static-vector-pointer pixel-data))))
(defun allocate-texture-storage (texture)
(with-slots (target storage level internal-format width height depth samples pixel-format pixel-type pixel-data) texture
(let ((internal-format (cffi:foreign-enum-value '%gl:enum internal-format))
(pixel-data (etypecase pixel-data
(cons pixel-data)
(cffi:foreign-pointer pixel-data)
(null (cffi:null-pointer)))))
(pixel-data (if (consp pixel-data)
(mapcar #'coerce-pixel-data pixel-data)
(coerce-pixel-data pixel-data))))
(case target
((:texture-1d)
(ecase storage
View
@@ -8,6 +8,10 @@
(defvar *static-vector-map* (tg:make-weak-hash-table :weakness :key :test 'eq))
(declaim (inline mark-static-vector))
(defun mark-static-vector (vector)
(setf (gethash vector *static-vector-map*) T))
(defun make-static-vector (length &rest args)
(let ((vec (apply #'static-vectors:make-static-vector length args)))
(setf (gethash vec *static-vector-map*) T)
View
@@ -145,6 +145,11 @@
(setf ,place ,value)
(go ,tag)))))))
(defmacro with-unwind-protection (cleanup &body body)
`(unwind-protect
(progn ,@body)
,cleanup))
(defmacro with-cleanup-on-failure (cleanup-form &body body)
(let ((success (gensym "SUCCESS")))
`(let ((,success NIL))

0 comments on commit 357b7c8

Please sign in to comment.