Permalink
Browse files

Fix print-case variance

  • Loading branch information...
Shinmera committed Dec 16, 2018
1 parent e8b1cd2 commit 79165263902157150488686487e19a494dc64221
@@ -44,7 +44,8 @@
(debug-context NIL debug-context-p))
(flet (((setf g) (value name) (setf (getf (initargs context) name) value)))
(macrolet ((maybe-set (var &optional (name (intern (string var) :keyword)))
`(when ,(intern (format NIL "~a-~a" var 'p))
`(when ,(let ((*print-case* (readtable-case *readtable*)))
(intern (format NIL "~a-~a" var 'p)))
(setf (g ,name) ,var))))
(maybe-set width)
(maybe-set height)
@@ -36,7 +36,8 @@
(depth-buffer NIL depth-buffer-p)
(stencil-buffer NIL stencil-buffer-p))
(macrolet ((maybe-set (var)
`(when ,(intern (format NIL "~a-~a" var 'p))
`(when ,(let ((*print-case* (readtable-case *readtable*)))
(intern (format NIL "~a-~a" var 'p)))
(setf (getf (initargs context) ,(intern (string var) :keyword))
,var))))
(maybe-set width)
@@ -47,7 +47,8 @@
(with-accessors ((format glformat)) context
(unless format (setf format (q+:make-qglformat)))
(macrolet ((maybe-set (variable setter)
`(when ,(intern (format NIL "~a-~a" variable :p))
`(when ,(let ((*print-case* (readtable-case *readtable*)))
(intern (format NIL "~a-~a" variable :p)))
(setf (q+ ,setter format) ,variable))))
(maybe-set accumulation-buffer accum)
(maybe-set alpha-buffer alpha)
@@ -16,8 +16,9 @@
(refresh-instances symbol-inspector))

(defmacro define-symbol-attr (name &key reader accessor bound-test unbinder)
(let ((set-name (intern (format NIL "~a-~a" 'set name)))
(unbind-name (intern (format NIL "~a-~a" 'unbind name))))
(let* ((*print-case* (readtable-case *readtable*))
(set-name (intern (format NIL "~a-~a" 'set name)))
(unbind-name (intern (format NIL "~a-~a" 'unbind name))))
`(progn
(define-subwidget (symbol-inspector ,name)
,(if reader
@@ -214,8 +214,9 @@
(defun destructure-texture-format (format)
(cl-ppcre:register-groups-bind (compression signed super r r-size r-type g g-size g-type b b-size b-type rg rg-size rg-type rgb rgb-size rgb-type rgba rgba-size rgba-type a a-size a-type e e-size d d-size d-type s s-size s-type rgtc bptc floatage snorm unorm) ("^(compressed-)?(signed-)?(s)?((?:red|r)(\\d+)?(ui|i|f)?)?(-g(\\d+)?(ui|i|f)?)?(-b(\\d+)?(ui|i|f)?)?(rg(\\d+)?(ui|i|f)?)?(rgb(\\d+)?(ui|i|f)?)?(rgba(\\d+)?(ui|i|f)?)?(-(?:a|alpha)(\\d+)?(ui|i|f)?)?(-e(\\d+)?)?(depth(?:-component-?)?(\\d+)?(f)?)?(-stencil(\\d+)?(ui|i|f)?)?(-rgtc\\d)?(-bptc)?(-signed-float|-unsigned-float)?(-snorm)?(-unorm)?$" (string-downcase format))
(macrolet ((parse-part (part)
(let ((type (intern (format NIL "~a-~a" part 'type)))
(size (intern (format NIL "~a-~a" part 'size))))
(let* ((*print-case* (readtable-case *readtable*))
(type (intern (format NIL "~a-~a" part 'type)))
(size (intern (format NIL "~a-~a" part 'size))))
`(when ,part
(list (when ,size (parse-integer ,size))
(cond ((or (equalp ,type "f") floatage) :float)
@@ -110,7 +110,8 @@

(defun generate-prepare-pass-program (&optional (units (gl:get* :max-texture-image-units)))
(check-type units (integer 1))
(let ((units (loop for i downfrom (1- units) to 0 collect i)))
(let ((*print-case* (readtable-case *readtable*))
(units (loop for i downfrom (1- units) to 0 collect i)))
`(lambda (pass program)
(loop with texture-index = ',units
with texture-name = ',(loop for unit in units collect
@@ -527,8 +527,9 @@
width height max))))

(defmacro define-enum-check (name &body cases)
(let ((list (intern (format NIL "*~a-~a*" name '#:list)))
(func (intern (Format NIL "~a-~a" '#:check name))))
(let* ((*print-case* (readtable-case *readtable*))
(list (intern (format NIL "*~a-~a*" name '#:list)))
(func (intern (Format NIL "~a-~a" '#:check name))))
`(progn (defparameter ,list '(,@cases))
(defun ,func (enum)
(unless (find enum ,list)

0 comments on commit 7916526

Please sign in to comment.