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(a)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(a)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(a)common-lisp.net>**20061117024105
Patch courtesy of Bart Botta.
]
[Applied patch from Bart Botta
Oliver Markovic <entrox(a)entrox.org>**20061112111533]
[Pushed wrong version of render-to-texture.lisp; fixed
Oliver Markovic <entrox(a)entrox.org>**20061111152828]
[Add render-to-texture example
Oliver Markovic <entrox(a)entrox.org>**20061111151241
- Add new example in examples/misc/ illustrating the use of FBOs
]
[Add support for buffer objects
Oliver Markovic <entrox(a)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(a)jamesjb.com>**20060830200239]
[Implement GLU projection functions.
James Bielman <jamesjb(a)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(a)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(a)jamesjb.com>**20060828052308]
[Add a script to generate OpenGL constants from the specifiction.
James Bielman <jamesjb(a)jamesjb.com>**20060828051427]
[Add OpenGL specification data files for enum values.
James Bielman <jamesjb(a)jamesjb.com>**20060828051348]
[Define foreign functions inline via DEFGLFUN helper macro.
James Bielman <jamesjb(a)jamesjb.com>**20060828045747]
[Move GL function DEFCFUNs into funcs.lisp.
James Bielman <jamesjb(a)jamesjb.com>**20060828045514]
[More 64-bit-cleanliness fixes, use ints instead of longs.
James Bielman <jamesjb(a)jamesjb.com>**20060828044816]
[Fix bug in WITH-OPENGL-ARRAY when VAR and LISP-ARRAY are the same.
James Bielman <jamesjb(a)jamesjb.com>**20060823210517]
[Use :INT as the base type for GL:INT and GL:SIZEI.
James Bielman <jamesjb(a)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(a)common-lisp.net>**20060703224124]
[CL-GLUT update
Luis Oliveira <loliveira(a)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(a)common-lisp.net>**20060425212810]
[Convert array contents to floats in MAP1 and MAP2.
James Bielman <jamesjb(a)jamesjb.com>**20060412015458]
[Add evaluator constants to the ENABLE-CAP enum.
James Bielman <jamesjb(a)jamesjb.com>**20060412015045]
[New example: glut-teapot.lisp
Luis Oliveira <loliveira(a)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(a)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(a)common-lisp.net>**20060221054151
- add ignore declarations to unused arguments.
- use MOD!
]
[Oops. Forgot to darcs add examples/mesademos/package.lisp
Luis Oliveira <loliveira(a)common-lisp.net>**20060219211853]
[More examples
Luis Oliveira <loliveira(a)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(a)common-lisp.net>**20060218051830]
[GLUT: use gl:ensure-double
Luis Oliveira <loliveira(a)common-lisp.net>**20060217231013]
[Small change to with-opengl-sequence
Luis Oliveira <loliveira(a)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(a)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(a)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(a)common-lisp.net>**20060207034827]
[New examples
Luis Oliveira <loliveira(a)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(a)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(a)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(a)common-lisp.net>**20060202200413]
[Add fps counter to examples/mesademos/gears.lisp
Luis Oliveira <loliveira(a)common-lisp.net>**20060202195354]
[Texturing functions added.
Oliver Markovic <entrox(a)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(a)common-lisp.net>**20060202190632]
[GLUT update, less straw.
Luis Oliveira <loliveira(a)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(a)gmail.com>**20060202031904]
[Big patch, lots of straw again.
Luis Oliveira <loliveira(a)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(a)common-lisp.net>**20060201013908
Just straw, no content. Taken from cffi mostly.
]
[Minor changes
Luis Oliveira <loliveira(a)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(a)entrox.org>**20060131120521]
[Initial revision.
Oliver Markovic <entrox(a)entrox.org>**20060131115438]
Patch bundle hash:
727eee476e9486b933565b414282d0b16d35805a
