lisp

(defmacro with-foreign-slots ((vars ptr type) &body body)
  "Create local symbol macros for each var in VARS to reference
foreign slots in PTR of TYPE. Similar to WITH-SLOTS.
Each var can be of the form: slot-name - in which case slot-name will
be bound to the value of the slot or: (:pointer slot-name) - in which
case slot-name will be bound to the pointer to that slot."
  (let ((ptr-var (gensym "PTR")))
    `(let ((,ptr-var ,ptr))
       (symbol-macrolet
           ,(loop :for var :in vars
              :collect
              (if (listp var)
                  (if (eq (first var) :pointer)
                      `(,(second var) (foreign-slot-pointer
                                       ,ptr-var ',type ',(second var)))
                      (error
                       "Malformed slot specification ~a; must be:`name' or `(:pointer name)'"
                       var))
                  `(,var (foreign-slot-value ,ptr-var ',type ',var))))
         ,@body))))


;;;; expands to


(LET ((#:PTR645 P-ES-CONTEXT))
  (SYMBOL-MACROLET ((WIDTH
                     (CFFI:FOREIGN-SLOT-VALUE #:PTR645 'ES-CONTEXT 'WIDTH))
                    (HEIGHT
                     (CFFI:FOREIGN-SLOT-VALUE #:PTR645 'ES-CONTEXT 'HEIGHT))
                    (EGL-NATIVE-DISPLAY
                     (CFFI:FOREIGN-SLOT-VALUE #:PTR645 'ES-CONTEXT
                                              'EGL-NATIVE-DISPLAY))
                    (EGL-CONTEXT
                     (CFFI:FOREIGN-SLOT-VALUE #:PTR645 'ES-CONTEXT
                                              'EGL-CONTEXT))
                    (EGL-NATIVE-WINDOW
                     (CFFI:FOREIGN-SLOT-VALUE #:PTR645 'ES-CONTEXT
                                              'EGL-NATIVE-WINDOW)))
    (FORMAT T
            "~%egl-native-display ~d,  egl-context ~d, egl-native-window ~d~%"
            EGL-NATIVE-DISPLAY EGL-CONTEXT EGL-NATIVE-WINDOW)
    (ASSERT
     (AND (= WIDTH CONTEXT-WIDTH) (= HEIGHT CONTEXT-HEIGHT)
          (AND (CFFI-SYS:POINTERP EGL-DISPLAY)
               (NOT (ZEROP (CFFI-SYS:POINTER-ADDRESS EGL-DISPLAY))))
          (AND (NUMBERP EGL-NATIVE-WINDOW) (NOT (ZEROP EGL-NATIVE-WINDOW)))))))