Hi, I am new to Lisp and experimenting with cl-opengl. I really wanted to see how I can use textures in Lisp (without having to copy the elements of the array too much). Strangely there was no example in the cl-opengl package.
So this is what I've come up with. Copy the code to minimal_texture_example.lisp and run sbcl --load minimal_texture_example.lisp
It will open a window. Press 't' to create a texture and 'space' to fill it with some pattern.
The interesting part is that with sb-sys:without-gcing and sb-sys:vector-sap the starting-pointer of the array can be extracted and used in gl:tex-sub-image-2d.
I also wrote a small wrapper library in C to capture YUV-frames from a webcam with v4l2 and display the data with (gl:tex-sub-image-2d :texture-rectangle-nv 0 0 0 +width+ +height+ :ycbcr-mesa :unsigned-short-8-8-rev-mesa (video-take)) It is quite fast.
Martin Kielhorn
#| use cl-opengl to display some texture |# (require 'cl-glut) (defpackage texture-example (:use :cl)) (in-package texture-example)
(defparameter +width+ 512) ; must be power of two (defparameter +height+ 512) ; must be power of two (defparameter +window-width+ 800) (defparameter +window-height+ 600)
(defclass window (glut:window) ((tex :accessor tex :initform #x0)) (:default-initargs :pos-x 100 :pos-y 100 :width +window-width+ :height +window-height+ :mode '(:double :rgb)))
(defmethod glut:display ((win window)) "draw a textured QUAD" (gl:clear :color-buffer-bit) (gl:load-identity) (gl:with-primitive :quads (gl:tex-coord 0 0)(gl:vertex +width+ +height+) (gl:tex-coord 1 0)(gl:vertex 0 +height+) (gl:tex-coord 1 1)(gl:vertex 0 0) (gl:tex-coord 0 1)(gl:vertex +width+ 0)) (glut:swap-buffers))
(defmethod glut:reshape ((win window) width height) (when (zerop height) (setq height 1)) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (gl:ortho 0 +window-width+ 0 +window-height+ -1 1) (gl:matrix-mode :modelview) (gl:load-identity))
(defvar *field* (make-array (* +width+ +height+ 4) :element-type '(unsigned-byte 8)))
(defun update-tex (win) (unless (eq (tex win) #x0) (loop for i below +width+ do (loop for j below +height+ do (let ((pixel (* 4 (+ i (* +width+ j))))) (setf (aref *field* (+ 0 pixel)) (mod i 215) (aref *field* (+ 1 pixel)) (mod j 215))))) (sb-sys:without-gcing (let ((addr (sb-sys:vector-sap *field*))) (gl:tex-sub-image-2d :texture-2d 0 0 0 +width+ +height+ :rgba :unsigned-byte addr)))))
(defmethod glut:keyboard ((win window) key x y) (declare (ignore x y)) (case key ;; switch textures on/off (#\t (if (eq (tex win) #x0) (progn (setf (tex win) (first (gl:gen-textures 1))) (gl:enable :texture-2d) (gl:bind-texture :texture-2d (tex win)) (gl:tex-parameter :texture-2d :texture-min-filter :nearest) (gl:tex-parameter :texture-2d :texture-mag-filter :nearest) (gl:tex-image-2d :texture-2d 0 :rgba +width+ +height+ 0 :rgba :unsigned-byte (cffi:null-pointer))) (progn (gl:delete-textures (list (tex win))) (gl:disable :texture-2d) (setf (tex win) #x0)))) (#\space (update-tex win)) (#\q (glut:destroy-current-window) (sb-ext:quit))) (glut:post-redisplay))
(defmethod glut:idle ((win window)) (sleep (/ 1. 30.)) (glut:post-redisplay))
(defun view () (glut:display-window (make-instance 'window)))
(view)