common lisp: nested loop beautification (checkboard texture generator) I've written a small code snippet that generates checkboard texture using cl-opengl.

(defun init-texture (tex)
    (gl:bind-texture :texture-2d tex)
    (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
    (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
    (print *test-texture*)
    (let* ((tex-w 16) (tex-h 16) (pixel-size 4) 
        (pixel-data (make-array (* (* tex-w tex-h) pixel-size) :element-type '(unsiged-byte 8) :adjustable nil :initial-element 0)))
    (loop for y from 0 to (- tex-h 1) do 
        (let ((line-offset (* (* tex-w pixel-size) y)))
            (loop for x from 0 to (- tex-w 1) do 
                (let ((x-offset (+ line-offset (* x pixel-size))) (c (if (oddp (+ x y)) 255 0)))
                    (setf (aref pixel-data x-offset) 255)
                    (setf (aref pixel-data (+ x-offset 1)) c)
                    (setf (aref pixel-data (+ x-offset 2)) c)
                    (setf (aref pixel-data (+ x-offset 3)) 255)))))
    (gl:tex-image-2d :texture-2d 0 :rgba tex-w tex-h 0 :rgba :unsigned-byte pixel-data)))


Problem: 
it looks ugly and is unnecessarily verbose, especially (- tex-h 1) and 4 setf in a row.

How can I "beautify"/simplify this?

Program logic:


generate 1d array of (unsigned-byte 8). Array size is tex-w*tex-h*pixel-size, where tex-w is 16, tex-h is 16, pixel-size is 4. 1 pixels. That's 16x16 texture data in rgba format where every pixel takes 4 elements.
Fill array. If (oddp (+ x y)), put white pixel, otherwise put blue pixel.
Not much better:

(defun init-texture (tex &amp;aux (tex-w 16) (tex-h 16) (pixel-size 4))
  (gl:bind-texture :texture-2d tex)
  (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
  (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
  (print *test-texture*)
  (let ((pixel-data (make-array (* tex-w tex-h pixel-size)
                                :element-type '(unsiged-byte 8)
                                :adjustable nil
                                :initial-element 0)))
    (loop for y below tex-h
          for line-offset = (* tex-w pixel-size y)
          do (loop for x below tex-w
                   for x-offset = (+ line-offset (* x pixel-size))
                   for c = (if (oddp (+ x y)) 255 0)
                   do  (setf (aref pixel-data (+ x-offset 0)) 255
                             (aref pixel-data (+ x-offset 1)) c
                             (aref pixel-data (+ x-offset 2)) c
                             (aref pixel-data (+ x-offset 3)) 255)))
    (gl:tex-image-2d :texture-2d 0 :rgba tex-w tex-h 0 :rgba :unsigned-byte pixel-data)))


To get rid of the arefs is not really possible. One way would be to use the function REPLACE:

(replace pixel-data (vector 255 c c 255) :start1 x-offset)


But now it allocates a vector for that. Then one might want to wish that the vector would be allocated on the stack:

(let ((new-data (vector 255 c c 255)))
  (declare (dynamic-extent new-data))
  (replace pixel-data (vector 255 c c 255) :start1 x-offset))


Another way is not to write the arefs, but to hide it behind a macro:

(defmacro vector-put-at ((vector start) &amp;rest data)
  `(progn
     ,@(loop for d in data and i from 0
             collect `(setf (aref ,vector (+ ,start ,i)) ,d))))


The you can write above as:

(defun init-texture (tex &amp;aux (tex-w 16) (tex-h 16) (pixel-size 4))
  (gl:bind-texture :texture-2d tex)
  (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
  (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
  (print *test-texture*)
  (let ((pixel-data (make-array (* tex-w tex-h pixel-size)
                                :element-type '(unsiged-byte 8)
                                :adjustable nil
                                :initial-element 0)))
    (loop for y below tex-h
          for line-offset = (* tex-w pixel-size y)
          do (loop for x below tex-w
                   for x-offset = (+ line-offset (* x pixel-size))
                   for c = (if (oddp (+ x y)) 255 0)
                   do (vector-put-at (pixel-data x-offset)
                        255 c c 255)
    (gl:tex-image-2d :texture-2d 0 :rgba tex-w tex-h 0 :rgba :unsigned-byte pixel-data)))