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