1
\$\begingroup\$

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:

  1. 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.
  2. Fill array. If (oddp (+ x y)), put white pixel, otherwise put blue pixel.
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

Not much better:

(defun init-texture (tex &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) &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 &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)))
\$\endgroup\$
2
  • \$\begingroup\$ Interesting, thanks. However, thinking about it, is there some kind of way to set 4 (consequent) array elements at once? that would eliminate multiple arefs. \$\endgroup\$
    – SigTerm
    Commented Aug 7, 2013 at 2:26
  • \$\begingroup\$ @SigTerm: see my edit above \$\endgroup\$ Commented Aug 7, 2013 at 6:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.