[cl-opengl-devel] a patch to add a support for the Vertex Arrays

Hi,

I created a patch for adding a support for Vertex Arrays in cl-opengl. It works great with the "aapoly" demo from the Red Book.

The main problem was to handle the vertex/color/etc.. arrays. The respective OpenGL functions do not copy them when called. Instead, they register their location and then reference them when functions like glDrawArray are called. That's why it was not convenient to use macros like (with-foreign-object ...) and I had to create a special class for managing these arrays.

Some parts of functionality like "glInterleavedArrays" is not implemented. That's because it is not clear for me how should it look like in Lisp. Actually, in such cases it does not seem to be a good idea to support this function at all.

Please let me know what is the best way to send you the patch. I will attach it to this email, but I am 99% sure it will be corrupted during transmission.

Regards, Denys

New patches:

[Adding preliminary support for Vertex Arrays Denys Rtveliashvili rtvd@mac.com**20070502190827] { hunk ./cl-glut-examples.asd 47 - ((:file "hello") + ((:file "aapoly") + (:file "hello") hunk ./cl-opengl.asd 41 + (:file "managed-cffi" :depends-on ("package")) hunk ./cl-opengl.asd 46 - (:file "util" :depends-on ("constants" "types")) - (:file "opengl" :depends-on ("funcs" "util")) + (:file "util" :depends-on ("constants" "types" "managed-cffi")) + (:file "opengl" :depends-on ("funcs" "util" "managed-cffi")) hunk ./examples/examples.lisp 11 - rb-double rb-hello #|rb-varray|# rb-lines rb-polys rb-cube rb-model + rb-aapoly rb-double rb-hello #|rb-varray|# rb-lines rb-polys rb-cube rb-model hunk ./gl/funcs.lisp 59 +(defglfun ("glArrayElement" %glArrayElement) :void + (i int)) + hunk ./gl/funcs.lisp 170 +(defglfun ("glClientActiveTexture" %glClientActiveTexture) :void + (texture enum)) + hunk ./gl/funcs.lisp 198 +(defglfun ("glColorPointer" %glColorPointer) :void + (size int) + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 329 +(defglfun ("glDisableClientState" %glDisableClientState) :void + (array enum)) + +(defglfun ("glDisableVertexAttribArray" %glDisableVertexAttribArray) :void + (index uint)) + +(defglfun ("glDrawArrays" %glDrawArrays) :void + (mode enum) + (first int) + (count sizei)) + hunk ./gl/funcs.lisp 347 +(defglfun ("glDrawElements" %glDrawElements) :void + (mode enum) + (count sizei) + (type enum) + (indices :pointer)) + +(defglfun ("glDrawRangeElements" %glDrawRangeElements) :void + (mode enum) + (start uint) + (end uint) + (count sizei) + (type enum) + (indices :pointer)) + hunk ./gl/funcs.lisp 366 +(defglfun ("glEdgeFlagPointer" %glEdgeFlagPointer) :void + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 372 +(defglfun ("glEnableClientState" %glEnableClientState) :void + (array enum)) + +(defglfun ("glEnableVertexAttribArray" %glEnableVertexAttribArray) :void + (index uint)) hunk ./gl/funcs.lisp 425 +(defglfun ("glFogCoordPointer" %glFogCoordPointer) :void + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 587 +(defglfun ("glIndexPointer" %glIndexPointer) :void + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 594 +(defglfun ("glInterleavedArrays" %glInterleavedArrays) :void + (frmat enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 721 +(defglfun ("glMultiDrawArrays" %glMultiDrawArrays) :void + (mode enum) + (first* int) + (count* sizei) + (primcount sizei)) + hunk ./gl/funcs.lisp 751 +(defglfun ("glNormalPointer" %glNormalPointer) :void + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 911 +(defglfun ("glSecondaryColorPointer" %glSecondaryColorPointer) :void + (size int) + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 979 +(defglfun ("glTexCoordPointer" %glTexCoordPointer) :void + (size int) + (type enum) + (stride sizei) + (pointer :pointer)) + hunk ./gl/funcs.lisp 1202 +(defglfun ("glVertexAttribPointer" %glVertexAttribPointer) :void + (index uint) + (size int) + (type enum) + (normalized boolean) + (stride sizei) + (pointer :pointer)) + +(defglfun ("glVertexPointer" %glVertexPointer) :void + (size int) + (type enum) + (stride sizei) + (pointer :pointer)) addfile ./gl/managed-cffi.lisp hunk ./gl/managed-cffi.lisp 1 - +;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- +;;; +;;; 2007 Denys Rtveliashvili rtvd@mac.com +;;; +;;;----------------------------------------------------------------------------- +;;; +;;; This file contains utilies for easy handling of CFFI arrays +;;; +;;;----------------------------------------------------------------------------- + +(in-package :cl-opengl) + +(defclass managed-cffi-array () + ((len :initform 0 :type fixnum :accessor len) + (native-array :initform nil :accessor native-array))) + +(defgeneric get-native-ptr (array) + (:documentation "Returns a pointer to a native array for the specified array.")) + +(defmethod get-native-ptr ((array managed-cffi-array)) + (slot-value array 'native-array)) + +(defun contents-length (source) + "Returns the length of the sequence. For 1D it is their length (non-recurive), for 2D it is the height of the array." + (if (null source) + 0 + (if (arrayp source) + (case (array-rank source) + ((0 1 2) + (array-dimension source 0)) + (t (error "Only arrays with rank 1 and 2 are supported"))) + + (length source)))) + +(defun element-length (source) + "Returns the length of the sequence's element. For 1D sequences it is one, for 2D arrays it is their width." + (if (null source) + 0 + (if (arrayp source) + (case (array-rank source) + ((0 1) 1) + (2 (array-dimension source 1)) + (t (error "Only arrays with rank 1 and 2 are supported"))) + + 1))) + +(defun contents-size (source) + "Calculates the full size of the contents. For 1D sequences that is their length, for 2D it is the product of the height by width." + (* (contents-length source) + (element-length source))) + + +(defun fill-foreign-array (array type source) + "Fills the foreign array with a data. In case of 2D array, the array is being flattened" + (if (arrayp source) + ;; the source is an array + (let ((flattened-array + (make-array (array-total-size source) + :element-type (array-element-type source) + :displaced-to source))) + (dotimes (i (length flattened-array)) + (setf (mem-aref array type i) + (aref flattened-array i)))) + + ;; a list, perhaps? + (dotimes (i (length source)) + (setf (mem-aref array type i) + (elt source i))))) + +(defgeneric allocate (array type &key shrink initial-contents count)) + +(defmethod allocate ((array managed-cffi-array) type &key shrink initial-contents (count (contents-size initial-contents))) + (with-slots ((oldsize len) + native-array) array + (let ((newsize (* count (foreign-type-size (eval type))))) + (when (or (> newsize oldsize) shrink) + (unless (zerop oldsize) + (foreign-free native-array) + (setf native-array nil) + (setf oldsize 0) + (cancel-finalization array)) + (unless (zerop newsize) + (setf oldsize newsize) + (let ((fresh-array (foreign-alloc type :count count))) + (setf native-array fresh-array) + (finalize array + (lambda () + (foreign-free native-array)))))) + (when initial-contents + (fill-foreign-array native-array type initial-contents))))) hunk ./gl/opengl.lisp 126 +;;; +;;; 2.8 Vertex Arrays +;;; + +(defmacro opengl-pointer-function + ((function-name + default-type + state-name + pointer-name + needs-width + &rest optionalFuncParameters) + &rest glPointerFunc) + + `(progn + (defparameter ,pointer-name (make-instance 'managed-cffi-array)) + (defun ,function-name (&optional source (type ,default-type) ,@optionalFuncParameters) + (if (null source) + (%glDisableClientState ,state-name) + ,(append + (if needs-width + `(let ((width (element-length source)))) + `(progn)) + + `((allocate ,pointer-name type :initial-contents source) + (let ((native-ptr (get-native-ptr ,pointer-name))) + ,@glPointerFunc) + (%glEnableClientState ,state-name))))))) + +(opengl-pointer-function + (vertex-pointer :unsigned-int :vertex-array *vertex-pointer* t) + (%glVertexPointer width type 0 native-ptr)) + +(opengl-pointer-function + (normal-pointer :double :normal-array *normal-pointer* nil) + (%glNormalPointer type 0 native-ptr)) + +(opengl-pointer-function + (color-pointer :uchar :color-array *color-pointer* t) + (%glColorPointer width type 0 native-ptr)) + +(opengl-pointer-function + (secondary-color-pointer :uchar :secondary-color-array *secondary-color-pointer* t) + (%glSecondaryColorPointer width type 0 native-ptr)) + +(opengl-pointer-function + (index-pointer :unsigned-int :index-array *index-pointer* nil) + (%glIndexPointer type 0 native-ptr)) + +(opengl-pointer-function + (edge-flag-pointer :boolean :edge-flag-array *edge-flag-pointer* nil) + (%glEdgeFlagPointer 0 native-ptr)) + +(opengl-pointer-function + (fog-coord-pointer :double :fog-coord-array *fog-coord-pointer* nil) + (%glFogCoordPointer type 0 native-ptr)) + +(opengl-pointer-function + (tex-coord-pointer :double :tex-coord-array *tex-coord-pointer* t) + (%glTexCoordPointer width type 0 native-ptr)) + +(opengl-pointer-function + (vertex-attrib-pointer :double :vertex-attrib-array *vertex-attrib-pointer* t index normalized) + (%glVertexAttribPointer index width type normalized 0 native-ptr)) + +(declaim (inline client-active-texture)) +(defun client-active-texture (enum) + (%glClientActiveTexture enum)) + +(declaim (inline array-element)) +(defun array-element (i) + (%glArrayElement i)) + +(declaim (inline draw-arrays)) +(defun draw-arrays (mode first count) + (%glDrawArrays mode first count)) + +(defun multi-draw-arrays (mode first-list count-list) + (with-opengl-1d-structure (f f-l-count :unsigned-int first-list) + (with-opengl-1d-structure (c c-l-count 'sizei count-list) + (if (not (eql f-l-count c-l-count)) + (error "The list of first elements should be as long as the list of segment lengths.")) + (%glMultiDrawArrays mode f c f-l-count)))) + +(defun draw-elements (mode lisp-indices) + (with-opengl-1d-structure (indices count 'uint lisp-indices) + (%glDrawElements mode count :unsigned-int indices))) + +;(defun multi-draw-elements (mode first-list count-list).... + +(defun draw-range-elements (mode start end lisp-indices) + (with-opengl-1d-structure (indices count :unsigned-int lisp-indices) + (%glDrawRangeElements mode start end count :unsigned-int indices))) + + +#|| +MultiDrawElements... +InterleavedArrays... +||# + hunk ./gl/package.lisp 65 + ;; 2.8 Vertex Arrays + #:vertex-pointer + #:normal-pointer + #:color-pointer + #:secondary-color-pointer + #:index-pointer + #:edge-flag-pointer + #:fog-coord-pointer + #:tex-coord-pointer + #:vertex-attrib-pointer +;; #:enable-client-state ;; should not be accessed directly! +;; #:disable-client-state ;; should not be accessed directly! + #:client-active-texture + #:array-element + #:draw-arrays + #:multi-draw-arrays + #:draw-elements +;; #:multi-draw-elements ;; hard to implement. Do we need it at all? + #:draw-range-elements +;; #:interleaved-arrays ;; hard to implement. Do we need it at all? hunk ./gl/util.lisp 109 +(defmacro with-opengl-1d-structure ((var count type lisp-sequence) &body body) + (once-only (type lisp-sequence) + `(let ((,count (contents-size ,lisp-sequence))) + (with-foreign-object (,var ,type ,count) + (fill-foreign-array ,var ,type ,lisp-sequence) + ,@body)))) + hunk ./gl/util.lisp 168 + }

Context:

[Misc patch Luis Oliveira loliveira@common-lisp.net**20061117024105

Patch courtesy of Bart Botta. ] [Applied patch from Bart Botta Oliver Markovic entrox@entrox.org**20061112111533] [Pushed wrong version of render-to-texture.lisp; fixed Oliver Markovic entrox@entrox.org**20061111152828] [Add render-to-texture example Oliver Markovic entrox@entrox.org**20061111151241

- Add new example in examples/misc/ illustrating the use of FBOs ] [Add support for buffer objects Oliver Markovic entrox@entrox.org**20061111151103

- Add vertex and pixel buffer objects - Add support for the EXT_framebuffer_object extension ] [Fix downcasing issues with enum generation. James Bielman jamesjb@jamesjb.com**20060830200239] [Implement GLU projection functions. James Bielman jamesjb@jamesjb.com**20060828054332

- New exported functions: GLU:PROJECT, GLU:UN-PROJECT, GLU:UN-PROJECT4. - New utility macro: WITH-OPENGL-ARRAYS for binding multiple arrays. ] [Implement numeric OpenGL state querying functions. James Bielman jamesjb@jamesjb.com**20060828054131

- New exported functions: GET-BOOLEAN, GET-DOUBLE, GET-FLOAT, GET-INTEGER, and GET-ENUM. These functions are able to automatically return the correct number of return values when the query enum is in the *QUERY-ENUM-SIZES* table. ] [Replace separate enum types with generated GL:ENUM. James Bielman jamesjb@jamesjb.com**20060828052308] [Add a script to generate OpenGL constants from the specifiction. James Bielman jamesjb@jamesjb.com**20060828051427] [Add OpenGL specification data files for enum values. James Bielman jamesjb@jamesjb.com**20060828051348] [Define foreign functions inline via DEFGLFUN helper macro. James Bielman jamesjb@jamesjb.com**20060828045747] [Move GL function DEFCFUNs into funcs.lisp. James Bielman jamesjb@jamesjb.com**20060828045514] [More 64-bit-cleanliness fixes, use ints instead of longs. James Bielman jamesjb@jamesjb.com**20060828044816] [Fix bug in WITH-OPENGL-ARRAY when VAR and LISP-ARRAY are the same. James Bielman jamesjb@jamesjb.com**20060823210517] [Use :INT as the base type for GL:INT and GL:SIZEI. James Bielman jamesjb@jamesjb.com**20060823171453

- Using :LONG broke on 64-bit Linux. According to the GL header on my Linux system, GLint and GLsizei are of C type 'int'. ] [Minor fix to glut/interface.lisp Luis Oliveira loliveira@common-lisp.net**20060703224124] [CL-GLUT update Luis Oliveira loliveira@common-lisp.net**20060624235928

- Fix foreign-symbol-pointer usage in glut/fonts.lisp. - Move enums next to the DEFCFUNs where they're used. - Rework the CL-GLUT CLOS interface. - Reorganize examples and rewrite them using the updated CLOS interface. ] [s/windows/cffi-features:windows Luis Oliveira loliveira@common-lisp.net**20060425212810] [Convert array contents to floats in MAP1 and MAP2. James Bielman jamesjb@jamesjb.com**20060412015458] [Add evaluator constants to the ENABLE-CAP enum. James Bielman jamesjb@jamesjb.com**20060412015045] [New example: glut-teapot.lisp Luis Oliveira loliveira@common-lisp.net**20060326211537

Also, fixed a typo in the README and added a README for the examples. ] [GLUT: add missing event and fix typo Luis Oliveira loliveira@common-lisp.net**20060221054305

- Missing event: passive-motion. - fullscreen -> full-screen - move the (setf title) magic to a :before method. ] [Minor fixes to the examples Luis Oliveira loliveira@common-lisp.net**20060221054151

- add ignore declarations to unused arguments. - use MOD! ] [Oops. Forgot to darcs add examples/mesademos/package.lisp Luis Oliveira loliveira@common-lisp.net**20060219211853] [More examples Luis Oliveira loliveira@common-lisp.net**20060218054241

- New examples: rb{6,7,8,9,10,11,12,13}. - Use with-new-list in mesademos/gears.lisp. - Add copyright notices to examples. - Fix example 4 which was drawing *halftone* twice. ] [with-new-list, with-primitive and call-lists Luis Oliveira loliveira@common-lisp.net**20060218051830] [GLUT: use gl:ensure-double Luis Oliveira loliveira@common-lisp.net**20060217231013] [Small change to with-opengl-sequence Luis Oliveira loliveira@common-lisp.net**20060217224915

- Make it convert the sequence's elements to float or double when the type is gl:float or gl:double respectively. Breaks when type isn't constant, oops. ] [Tiny update to GLU Luis Oliveira loliveira@common-lisp.net**20060217222227

- Mostly move files around. (remind not to create stub files again, ugh) - Added some new functions. ] [New types: gl:ensure-double and gl:ensure-float Luis Oliveira loliveira@common-lisp.net**20060217221729

- Define and export ensure-double and ensure-float. (these need a recent CFFI) - Also export some types that'll be needed for GLU. Maybe a gl-types package would be a good idea? ] [Oops. Forgot darcs add. Luis Oliveira loliveira@common-lisp.net**20060207034827] [New examples Luis Oliveira loliveira@common-lisp.net**20060207032245

- New 5 examples from the redbook. - 2 GLU functions needed for the examples. - Added gl:polygon-stipple needed for one of the examples. - Fixed silly bugs in cl-glut's ascii-to-char type and the base-window initialize-instance. - Moved window's title initform to a special. ] [Preliminary CLOS interface to GLUT Luis Oliveira loliveira@common-lisp.net**20060206182638

- Removed a german 'ss' from rasterization.lisp which was upsetting SBCL. - New macro WITH-PUSHED-MATRIX. WITH-MATRIX might be a better name? - New experimental CLOS-based interface to GLUT. - New example using the new CLOS interface. Moved old gears exmample to gears-raw.lisp. ] [Optimizations (needs recent CFFI again) Luis Oliveira loliveira@common-lisp.net**20060203014020

- Add declarations in gears.lisp - Define the gl:* types to have no translation ] [Use internal-time-units-per-second Luis Oliveira loliveira@common-lisp.net**20060202200413] [Add fps counter to examples/mesademos/gears.lisp Luis Oliveira loliveira@common-lisp.net**20060202195354] [Texturing functions added. Oliver Markovic entrox@entrox.org**20060202185907

- Added preliminary support for glTexImage and glTexSubImage. I'm still not sure on how to handle the data. - Added glCopyTexImage and glCopyTexSubImage - Added glAreTexturesResident and glPrioritizeTextures along with TEXTURE-RESIDENT-P and PRIORITIZE-TEXTURE, which are hopefully less awkward to use than the direct translations. - Added glTexEnv. ] [Oops. Missing glut/main.lisp file. Luis Oliveira loliveira@common-lisp.net**20060202190632] [GLUT update, less straw. Luis Oliveira loliveira@common-lisp.net**20060202124342

(requires recent cffi patches fixing defcenum issue and implementing defbitfield)

- add missing depends-on to funcs in cl-opengl.asd - complete glut bindings. next step: high level interface. ] [Add glutSetOption. Alexey Dvoychenkov keriax@gmail.com**20060202031904] [Big patch, lots of straw again. Luis Oliveira loliveira@common-lisp.net**20060201164339

- GLU: added asd file and stub .lisp files. - Examples: - added cl-glut-examples.asd - new example: gears.lisp - GLUT: added asd file and implemented a few routines. (mostly those needed by the gears.lisp example) - Add my name to HEADER too. - 3 separate manuals is probably overkill? Use only one for now. - GL: - fixed enums, these should canonicalize to GLenum, not int. - renamed gl types from GLfoo to gl:foo (and exported them) - fixed erroneus check-type. - look for libGL.so.N if libGL.so isn't found. - removed some tabs from the files. - added missing space between ":constant-attenuation" and "linear-attenuation". - added missing (declare (ignore ..)) to avoid warnings. - fixed a small bug/typo where a foreign array was being accessed as if it were Lisp array. - change ;;;-comments to ;;-comments in package.lisp in order to indent well. ] [Add documentation structure. Luis Oliveira loliveira@common-lisp.net**20060201013908

Just straw, no content. Taken from cffi mostly. ] [Minor changes Luis Oliveira loliveira@common-lisp.net**20060131190956

- added HEADER file. - changed library.lisp to use BSD license. - removed tabs from state.lisp ] [Added examples directory. Oliver Markovic entrox@entrox.org**20060131120521] [Initial revision. Oliver Markovic entrox@entrox.org**20060131115438] Patch bundle hash: 727eee476e9486b933565b414282d0b16d35805a