Using cl-vectors with opticl

opticl-cl-vectors.lisp

(let ((state (aa:make-state)))       ; create the state
  ;; the 1st triangle
  (aa:line-f state 200 50 250 150)   ; describe the 3 sides
  (aa:line-f state 250 150 50 100)   ; of the first triangle
  (aa:line-f state 50 100 200 50)
  ;; the 2nd triangle
  (aa:line-f state 75 25 10 75)      ; describe the 3 sides
  (aa:line-f state 10 75 175 100)    ; of the second triangle
  (aa:line-f state 175 100 75 25)
  (let* ((image (opticl:make-8-bit-rgba-image 200 300 :initial-element 255)))
    (labels ((alpha/normalized (alpha)
	       (min 255 (abs alpha)))
	     (alpha/even-odd (alpha)
	       (min 255 (- 256 (abs (- 256 (mod (abs alpha) 512))))))
	     (put-pixel (x y alpha)
	       (setf (opticl:pixel image y x) (values 0 0 0 (min 255 (abs alpha))))))
      (aa:cells-sweep state #'put-pixel)
      (opticl:write-png-file #P"triangles.png" image))))


(defun opticl-image-gl-tex (target level image &key border)
  (opticl:with-image-bounds (width height channels)
      image
      (let ((format
	     (case channels
	       (1 1)
	       (3 :bgr)
	       (4 :bgra))))
	(cffi:with-foreign-object (foreign-image :uint8 (* width height channels))
	  (case channels 
	    (1 (opticl:do-pixels (y x)
		   image
		   (setf (cffi:mem-aref foreign-image
					:uint8 (+ x (* y width)))
			 (opticl:pixel image y x))))		;; gray
	    (3 (opticl:do-pixels (y x)
		   image
		 (multiple-value-bind
		       (r g b)
		     (opticl:pixel image y x)
		 (let ((index (* (+ x (* y width)) 3)))
		   (setf (cffi:mem-aref foreign-image :uint8 index) b)
		   (setf (cffi:mem-aref foreign-image :uint8 (+ 1 index)) g)
		   (setf (cffi:mem-aref foreign-image :uint8 (+ 2 index)) r)))))
	    (4 (opticl:do-pixels (y x)
		   image
		 (multiple-value-bind
		       (r g b a)		     
		     (opticl:pixel image y x)
		 (let ((index (* (+ x (* y width)) 3)))
		   (setf (cffi:mem-aref foreign-image :uint8 index) b)
		   (setf (cffi:mem-aref foreign-image :uint8 (+ 1 index)) g)
		   (setf (cffi:mem-aref foreign-image :uint8 (+ 2 index)) r)
		   (setf (cffi:mem-aref foreign-image :uint8 (+ 3 index)) a))))))
	   (%gl:tex-image-2d target level format width height (if border 1 0) format  :unsigned-byte foreign-image)))))