From 9272284065de99a999b3d0a84bd20566406e8553 Mon Sep 17 00:00:00 2001 From: William Robinson Date: Sun, 21 Oct 2007 18:12:52 +0100 Subject: [PATCH] Automatic conversion of gl:booleans, gl:floats and gl:doubles. --- examples/keytest.lisp | 2 +- examples/mipmaps.lisp | 7 +- examples/simple.lisp | 30 ++-- examples/triangle.lisp | 2 +- examples/vbo.lisp | 6 +- generators/make-bindings-from-spec.lisp | 10 +- lib/glfw.lisp | 51 +++--- lib/opengl.lisp | 272 +++++++++++++++++++------------- src/opengl-template.lisp | 30 +++- 9 files changed, 243 insertions(+), 167 deletions(-) rewrite examples/simple.lisp (64%) diff --git a/examples/keytest.lisp b/examples/keytest.lisp index a8d91b0..50ec3a2 100644 --- a/examples/keytest.lisp +++ b/examples/keytest.lisp @@ -55,7 +55,7 @@ (force-output)) (defun main () - (unless (eql gl:+true+ (glfw:open-window 250 100 0 0 0 0 0 0 glfw:+window+)) + (unless (glfw:open-window 250 100 0 0 0 0 0 0 glfw:+window+) (return-from main)) (glfw:set-key-callback (cffi:callback keyfun)) diff --git a/examples/mipmaps.lisp b/examples/mipmaps.lisp index 1d5f372..ab91704 100644 --- a/examples/mipmaps.lisp +++ b/examples/mipmaps.lisp @@ -3,15 +3,14 @@ (defun main () - (unless (eql gl:+true+ (glfw:open-window 640 480 0 0 0 0 0 0 glfw:+window+)) + (unless (glfw:open-window 640 480 0 0 0 0 0 0 glfw:+window+) (return-from main)) (glfw:enable glfw:+sticky-keys+) (glfw:swap-interval 0) - (unless (eql gl:+true+ - (glfw:load-texture-2d (namestring (merge-pathnames "mipmaps.tga" (or *load-pathname* #P"examples/"))) - glfw:+build-mipmaps-bit+)) + (unless (glfw:load-texture-2d (namestring (merge-pathnames "mipmaps.tga" (or *load-pathname* #P"examples/"))) + glfw:+build-mipmaps-bit+) (return-from main)) (gl:tex-parameter-i gl:+texture-2d+ gl:+texture-min-filter+ gl:+linear-mipmap-linear+) diff --git a/examples/simple.lisp b/examples/simple.lisp dissimilarity index 64% index 9b7c5a1..52c6ec6 100644 --- a/examples/simple.lisp +++ b/examples/simple.lisp @@ -1,15 +1,15 @@ -(require '#:asdf) -(asdf:oos 'asdf:load-op '#:cl-glfw) - -(glfw:do-window ("A Simple Example") - ((gl:with-setup-projection - (glu:perspective 45.0d0 (/ 4.0d0 3.0d0) 0.1d0 50.0d0))) - (gl:clear gl:+color-buffer-bit+) - (gl:load-identity) - (gl:translate-f 0.0 0.0 -5.0) - (gl:rotate-d (* 10.0d0 (glfw:get-time)) 1d0 1d0 0d0) - (gl:rotate-d (* 90.0d0 (glfw:get-time)) 0d0 0d0 1d0) - (gl:with-begin gl:+triangles+ - (gl:color-3f 1.0 0.0 0.0) (gl:vertex-3f 1.0 0.0 0.0) - (gl:color-3f 0.0 1.0 0.0) (gl:vertex-3f -1.0 1.0 0.0) - (gl:color-3f 0.0 0.0 1.0) (gl:vertex-3f -1.0 -1.0 0.0))) \ No newline at end of file +(require '#:asdf) +(asdf:oos 'asdf:load-op '#:cl-glfw) + +(glfw:do-window ("A Simple Example") + ((gl:with-setup-projection + (glu:perspective 45 4/3 0.1 50))) + (gl:clear gl:+color-buffer-bit+) + (gl:load-identity) + (gl:translate-f 0 0 -5) + (gl:rotate-f (* 10 (glfw:get-time)) 1 1 0) + (gl:rotate-f (* 90 (glfw:get-time)) 0 0 1) + (gl:with-begin gl:+triangles+ + (gl:color-3f 1 0 0) (gl:vertex-3f 1 0 0) + (gl:color-3f 0 1 0) (gl:vertex-3f -1 1 0) + (gl:color-3f 0 0 1) (gl:vertex-3f -1 -1 0))) \ No newline at end of file diff --git a/examples/triangle.lisp b/examples/triangle.lisp index 8c6cc23..9fdddb9 100644 --- a/examples/triangle.lisp +++ b/examples/triangle.lisp @@ -3,7 +3,7 @@ (glfw:init) -(when (eql gl:+true+ (glfw:open-window 640 480 0 0 0 0 0 0 glfw:+window+)) +(when (glfw:open-window 640 480 0 0 0 0 0 0 glfw:+window+) (glfw:enable glfw:+sticky-keys+) (glfw:swap-interval 0) diff --git a/examples/vbo.lisp b/examples/vbo.lisp index b1344cb..8c393f2 100644 --- a/examples/vbo.lisp +++ b/examples/vbo.lisp @@ -108,29 +108,33 @@ *normals-vbo* (elt buffers 1) *colours-vbo* (elt buffers 2) *triangle-indices-vbo* (elt buffers 3))) + (format t "Loading in ~d bytes of indices~%" (* *triangle-indices-length* (cffi:foreign-type-size 'gl:uint)) ) (gl:with-bind-buffer-arb (gl:+element-array-buffer-arb+ *triangle-indices-vbo*) (gl:buffer-data-arb gl:+element-array-buffer-arb+ (* *triangle-indices-length* (cffi:foreign-type-size 'gl:uint)) *triangle-indices* gl:+static-draw-arb+)) + (format t "Loading in ~d bytes of vertices~%" (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) ) (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *vertices-vbo*) (gl:buffer-data-arb gl:+array-buffer-arb+ (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) *vertices-array* gl:+static-draw-arb+)) + (format t "Loading in ~d bytes of normals~%" (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) ) (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *normals-vbo*) (gl:buffer-data-arb gl:+array-buffer-arb+ (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) *normals-array* gl:+static-draw-arb+)) + (format t "Loading in ~d bytes of colours~%" (* *vertices-array-length* 4/3 (cffi:foreign-type-size 'gl:float)) ) (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *colours-vbo*) (gl:buffer-data-arb gl:+array-buffer-arb+ (* *vertices-array-length* 4/3 (cffi:foreign-type-size 'gl:float)) *colours-array* - gl:+dynamic-draw-arb+))) + gl:+static-draw-arb+))) (setf *t0* (glfw:get-time))) (let ((t1 (glfw:get-time))) diff --git a/generators/make-bindings-from-spec.lisp b/generators/make-bindings-from-spec.lisp index 3f7bfad..ed5637e 100644 --- a/generators/make-bindings-from-spec.lisp +++ b/generators/make-bindings-from-spec.lisp @@ -1,3 +1,11 @@ +;; proto-package for type-mappings only +(defpackage #:opengl + (:use #:cl) + (:nicknames #:gl) + (:shadow boolean byte float char string) + (:export + enum boolean bitfield byte short int sizei ubyte ushort uint float clampf + double clampd void uint64 int64 intptr sizeiptr handle char string half)) (defparameter *opengl-version-systems* '("cl-glfw-opengl-version_1_1" "cl-glfw-opengl-version_1_2" @@ -40,7 +48,7 @@ Must be in the correct order.") "WIN"))) (cond ((equal s "*") :void) ((find #\* (format nil "~a" s)) :pointer) - ((equal (subseq s 0 2) "GL") (intern (string-upcase (subseq s 2)))) + ((equal (subseq s 0 2) "GL") (intern (string-upcase (subseq s 2)) (find-package '#:gl))) ((equal s "_GLfuncptr") :pointer) (t s)))) diff --git a/lib/glfw.lisp b/lib/glfw.lisp index 226dcc9..942d57e 100644 --- a/lib/glfw.lisp +++ b/lib/glfw.lisp @@ -222,11 +222,10 @@ ;; Time spans longer than this (seconds) are considered to be infinity (defconstant +infinity+ 100000d0) -;; (declaim (ftype (function () (member gl:+true+ gl:+false+)) init)) -(defcfun+doc ("glfwInit" init) :int () +(defcfun+doc ("glfwInit" init) gl:boolean () "Return values -If the function succeeds, GL_TRUE is returned. -If the function fails, GL_FALSE is returned. +If the function succeeds, t is returned. +If the function fails, nil is returned. The glfwInit function initializes GLFW. No other GLFW functions may be used before this function has been called. @@ -250,14 +249,13 @@ GLFW library as a list (major minor rev).") "Call glfw:init, execute forms and clean-up with glfw:terminate once finished. This makes a nice wrapper to an application higher-level form. Signals an error on failure to initialize. Wrapped in a block named glfw:with-init." - `(if (eql (glfw:init) gl:+true+) + `(if (glfw:init) (unwind-protect (block with-init ,@forms) (glfw:terminate)) (error "Error initializing glfw"))) -;; (declaim (ftype (function () (member gl:+true+ gl:+false+)) open-window)) -(defcfun ("glfwOpenWindow" %open-window) :int +(defcfun ("glfwOpenWindow" %open-window) gl:boolean (width :int) (height :int) (redbits :int) (greenbits :int) (bluebits :int) (alphabits :int) (depthbits :int) (stencilbits :int) (mode :int)) @@ -289,8 +287,8 @@ mode mode will be changed to the resolution that closest matches the width and height parameters. Return values -If the function succeeds, GL_TRUE is returned. -If the function fails, GL_FALSE is returned. +If the function succeeds, t is returned. +If the function fails, nil is returned. Description The function opens a window that best matches the parameters given to the function. How well the @@ -346,8 +344,7 @@ window afterwards. An error is signalled if there was an error opening the windo Takes the same parameters as open-window, with the addition of 'title' which will set the window title after opening. Wrapped in a block named glfw:with-open-window." - `(if (eql (%open-window ,width ,height ,redbits ,greenbits ,bluebits ,alphabits ,depthbits ,stencilbits ,mode) - gl:+true+) + `(if (%open-window ,width ,height ,redbits ,greenbits ,bluebits ,alphabits ,depthbits ,stencilbits ,mode) (unwind-protect (block with-open-window (glfw:set-window-title ,title) @@ -396,6 +393,8 @@ cbfun be closed. If cbfun is NULL, any previously selected callback function will be deselected. + If you declare your callback as returning gl:boolean, you can use t and nil as return types. + Description The function selects which function to be called upon a window close event. A window has to be opened for this function to have any effect. @@ -972,7 +971,7 @@ latter should only happen when very short sleep times are specified, if at all. (bytes-per-pixel :int) (data :pointer)) -(defcfun+doc ("glfwReadImage" read-image) :int +(defcfun+doc ("glfwReadImage" read-image) gl:boolean ((name :string) (img image) (flags :int)) "Parameters name @@ -983,7 +982,7 @@ img flags Flags for controlling the image reading process. Valid flags are listed in table 3.6 Return values -The function returns GL_TRUE if the image was loaded successfully. Otherwise GL_FALSE is +The function returns t if the image was loaded successfully. Otherwise nil is returned. Description The function reads an image from the file specified by the parameter name and returns the image @@ -1014,7 +1013,7 @@ Please note that OpenGL™ 1.0 does not support single component alpha maps, so with Format = GL_ALPHA directly as textures under OpenGL™ 1.0. ") -(defcfun+doc ("glfwReadMemoryImage" read-memory-image) :int +(defcfun+doc ("glfwReadMemoryImage" read-memory-image) gl:boolean ((data :pointer) (size :long) (img image) (flags :int)) "Parameters data @@ -1027,7 +1026,7 @@ img flags Flags for controlling the image reading process. Valid flags are listed in table 3.6 Return values -The function returns GL_TRUE if the image was loaded successfully. Otherwise GL_FALSE is +The function returns t if the image was loaded successfully. Otherwise nil is returned. Description The function reads an image from the memory buffer specified by the parameter data and returns the @@ -1068,14 +1067,14 @@ The function frees any memory occupied by a loaded image, and clears all the fie struct. Any image that has been loaded by the glfwReadImage function should be deallocated using this function, once the image is not needed anymore. ") -(defcfun+doc ("glfwLoadTexture2D" load-texture-2d) :int ((name :string) (flags :int)) +(defcfun+doc ("glfwLoadTexture2D" load-texture-2d) gl:boolean ((name :string) (flags :int)) "Parameters name An ISO 8859-1 string holding the name of the file that should be loaded. flags Flags for controlling the texture loading process. Valid flags are listed in table 3.7. Return values -The function returns GL_TRUE if the texture was loaded successfully. Otherwise GL_FALSE is +The function returns t if the texture was loaded successfully. Otherwise nil is returned. Description @@ -1104,7 +1103,7 @@ to RGBA format under OpenGL™ 1.0 when the GLFW_ALPHA_MAP_BIT flag is set and t texture is a single component texture. The red, green and blue components are set to 1.0. ") -(defcfun+doc ("glfwLoadMemoryTexture2D" load-memory-texture-2d) :int +(defcfun+doc ("glfwLoadMemoryTexture2D" load-memory-texture-2d) gl:boolean ((data :pointer) (size :long) (flags :int)) "Parameters data @@ -1114,7 +1113,7 @@ size flags Flags for controlling the texture loading process. Valid flags are listed in table 3.7. Return values -The function returns GL_TRUE if the texture was loaded successfully. Otherwise GL_FALSE is +The function returns t if the texture was loaded successfully. Otherwise nil is returned. Description @@ -1144,7 +1143,7 @@ texture is a single component texture. The red, green and blue components are se ") -(defcfun+doc ("glfwLoadTextureImage2D" load-texture-image-2d) :int ((img image) +(defcfun+doc ("glfwLoadTextureImage2D" load-texture-image-2d) gl:boolean ((img image) (flags :int)) "Parameters img @@ -1152,7 +1151,7 @@ img flags Flags for controlling the texture loading process. Valid flags are listed in table 3.7. Return values -The function returns GL_TRUE if the texture was loaded successfully. Otherwise GL_FALSE is +The function returns t if the texture was loaded successfully. Otherwise nil is returned. Description @@ -1181,12 +1180,12 @@ to RGBA format under OpenGL™ 1.0 when the GLFW_ALPHA_MAP_BIT flag is set and t texture is a single component texture. The red, green and blue components are set to 1.0. ") -(defcfun+doc ("glfwExtensionSupported" extension-supported) :int ((extension :string)) +(defcfun+doc ("glfwExtensionSupported" extension-supported) gl:boolean ((extension :string)) "Parameters extension A null terminated ISO 8859-1 string containing the name of an OpenGL™ extension. Return values -The function returns GL_TRUE if the extension is supported. Otherwise it returns GL_FALSE. +The function returns t if the extension is supported. Otherwise it returns nil. Description The function does a string search in the list of supported OpenGL™ extensions to find if the specified extension is listed. @@ -1271,16 +1270,16 @@ This function is a very dangerous operation, which may interrupt a thread in the operation, and its use is discouraged. You should always try to end a thread in a graceful way using thread communication, and use glfwWaitThread in order to wait for the thread to die. ") -(defcfun+doc ("glfwWaitThread" wait-thread) :int ((id thread) (waitmode :int) ) +(defcfun+doc ("glfwWaitThread" wait-thread) gl:boolean ((id thread) (waitmode :int) ) "Parameters ID A thread identification handle, which is returned by glfwCreateThread or glfwGetThreadID. waitmode Can be either GLFW_WAIT or GLFW_NOWAIT. Return values -The function returns GL_TRUE if the specified thread died after the function was called, or the thread +The function returns t if the specified thread died after the function was called, or the thread did not exist, in which case glfwWaitThread will return immediately regardless of waitmode. The -function returns GL_FALSE if waitmode is GLFW_NOWAIT, and the specified thread exists and is still +function returns nil if waitmode is GLFW_NOWAIT, and the specified thread exists and is still running. ") (defcfun+doc ("glfwGetThreadID" get-thread-id) thread () diff --git a/lib/opengl.lisp b/lib/opengl.lisp index bfc568b..9c3405f 100644 --- a/lib/opengl.lisp +++ b/lib/opengl.lisp @@ -1,10 +1,14 @@ (defpackage #:opengl (:use #:cffi #:cl) (:nicknames #:gl) - (:shadow boolean byte float char string) + (:shadow #:boolean #:byte #:float #:char #:string) (:export - enum boolean bitfield byte short int sizei ubyte ushort uint float clampf - double clampd void uint64 int64 intptr sizeiptr handle char string half + #:enum #:boolean #:bitfield #:byte #:short #:int #:sizei #:ubyte #:ushort #:uint + #:float #:clampf #:double #:clampd #:void #:uint64 #:int64 + #:intptr #:sizeiptr + #:handle + #:char #:string + #:half +current-bit+ +point-bit+ @@ -4566,101 +4570,145 @@ blend-color-ext )) (defctype half :unsigned-short) ; this is how glext.h defines it anyway + (eval-when (:compile-toplevel :load-toplevel :execute) + + (defmethod cffi:expand-to-foreign (value (type (eql 'boolean))) + `(if ,value gl:+true+ gl:+false+)) + + (defmethod cffi:expand-from-foreign (value (type (eql 'boolean))) + `(not (= ,value gl:+false+))) + + (defmethod cffi:expand-to-foreign (value (type (eql 'float))) + `(coerce ,value 'single-float)) + + (defmethod cffi:expand-to-foreign (value (type (eql 'double))) + `(coerce ,value 'double-float)) + (let ((type-maps (quote -(|AccumOp| enum |AlphaFunction| enum |AttribMask| bitfield |BeginMode| enum - |BinormalPointerTypeEXT| enum |BlendEquationMode| enum |BlendEquationModeEXT| - enum |BlendFuncSeparateParameterEXT| enum |BlendingFactorDest| enum - |BlendingFactorSrc| enum |Boolean| boolean |BooleanPointer| :pointer |Char| - char |CharPointer| :pointer |CheckedFloat32| float |CheckedInt32| int - |ClampColorTargetARB| enum |ClampColorModeARB| enum |ClampedColorF| clampf - |ClampedFloat32| clampf |ClampedFloat64| clampd |ClampedStencilValue| int - |ClearBufferMask| bitfield |ClientAttribMask| bitfield |ClipPlaneName| enum - |ColorB| byte |ColorD| double |ColorF| float |ColorI| int |ColorIndexValueD| - double |ColorIndexValueF| float |ColorIndexValueI| int |ColorIndexValueS| - short |ColorIndexValueUB| ubyte |ColorMaterialParameter| enum - |ColorPointerType| enum |ColorS| short |ColorTableParameterPName| enum - |ColorTableParameterPNameSGI| enum |ColorTableTarget| enum - |ColorTableTargetSGI| enum |ColorUB| ubyte |ColorUI| uint |ColorUS| ushort - |CombinerBiasNV| enum |CombinerComponentUsageNV| enum |CombinerMappingNV| enum - |CombinerParameterNV| enum |CombinerPortionNV| enum |CombinerRegisterNV| enum - |CombinerScaleNV| enum |CombinerStageNV| enum |CombinerVariableNV| enum - |CompressedTextureARB| void |ControlPointNV| void |ControlPointTypeNV| enum - |ConvolutionParameter| enum |ConvolutionParameterEXT| enum |ConvolutionTarget| - enum |ConvolutionTargetEXT| enum |CoordD| double |CoordF| float |CoordI| int - |CoordS| short |CullFaceMode| enum |CullParameterEXT| enum |DepthFunction| - enum |DrawBufferMode| enum |DrawElementsType| enum |ElementPointerTypeATI| - enum |EnableCap| enum |ErrorCode| enum |EvalMapsModeNV| enum |EvalTargetNV| - enum |FeedbackElement| float |FeedbackType| enum |FenceNV| uint - |FenceConditionNV| enum |FenceParameterNameNV| enum |FfdMaskSGIX| bitfield - |FfdTargetSGIX| enum |Float32| float |Float32Pointer| :pointer |Float64| - double |Float64Pointer| :pointer |FogParameter| enum |FogPointerTypeEXT| enum - |FogPointerTypeIBM| enum |FragmentLightModelParameterSGIX| enum - |FragmentLightNameSGIX| enum |FragmentLightParameterSGIX| enum - |FramebufferAttachment| enum |FramebufferTarget| enum |FrontFaceDirection| - enum |FunctionPointer| :pointer |GetColorTableParameterPName| enum - |GetColorTableParameterPNameSGI| enum |GetConvolutionParameterPName| enum - |GetHistogramParameterPName| enum |GetHistogramParameterPNameEXT| enum - |GetMapQuery| enum |GetMinmaxParameterPName| enum |GetMinmaxParameterPNameEXT| - enum |GetPName| enum |GetPointervPName| enum |GetTextureParameter| enum - |HintMode| enum |HintTarget| enum |HintTargetPGI| enum |HistogramTarget| enum - |HistogramTargetEXT| enum |IglooFunctionSelectSGIX| enum |IglooParameterSGIX| - void |ImageTransformPNameHP| enum |ImageTransformTargetHP| enum - |IndexFunctionEXT| enum |IndexMaterialParameterEXT| enum |IndexPointerType| - enum |Int16| short |Int32| int |Int8| byte |InterleavedArrayFormat| enum - |LightEnvParameterSGIX| enum |LightModelParameter| enum |LightName| enum - |LightParameter| enum |LightTextureModeEXT| enum |LightTexturePNameEXT| enum - |LineStipple| ushort |List| uint |ListMode| enum |ListNameType| enum - |ListParameterName| enum |LogicOp| enum |MapAttribParameterNV| enum - |MapParameterNV| enum |MapTarget| enum |MapTargetNV| enum |MapTypeNV| enum - |MaskedColorIndexValueF| float |MaskedColorIndexValueI| uint - |MaskedStencilValue| uint |MaterialFace| enum |MaterialParameter| enum - |MatrixIndexPointerTypeARB| enum |MatrixMode| enum |MatrixTransformNV| enum - |MeshMode1| enum |MeshMode2| enum |MinmaxTarget| enum |MinmaxTargetEXT| enum - |NormalPointerType| enum |NurbsCallback| enum |NurbsObj| :pointer - |NurbsProperty| enum |NurbsTrim| enum |OcclusionQueryParameterNameNV| enum - |PixelCopyType| enum |PixelFormat| enum |PixelInternalFormat| enum |PixelMap| - enum |PixelStoreParameter| enum |PixelTexGenModeSGIX| enum - |PixelTexGenParameterNameSGIS| enum |PixelTransferParameter| enum - |PixelTransformPNameEXT| enum |PixelTransformTargetEXT| enum |PixelType| enum - |PointParameterNameARB| enum |PolygonMode| enum |ProgramNV| uint - |ProgramCharacterNV| ubyte |ProgramParameterNV| enum |ProgramParameterPName| - enum |QuadricCallback| enum |QuadricDrawStyle| enum |QuadricNormal| enum - |QuadricObj| :pointer |QuadricOrientation| enum |ReadBufferMode| enum - |RenderbufferTarget| enum |RenderingMode| enum |ReplacementCodeSUN| uint - |ReplacementCodeTypeSUN| enum |SamplePassARB| enum |SamplePatternEXT| enum - |SamplePatternSGIS| enum |SecondaryColorPointerTypeIBM| enum |SelectName| uint - |SeparableTarget| enum |SeparableTargetEXT| enum |ShadingModel| enum |SizeI| - sizei |SpriteParameterNameSGIX| enum |StencilFunction| enum - |StencilFaceDirection| enum |StencilOp| enum |StencilValue| int |String| - string |StringName| enum |TangentPointerTypeEXT| enum |TessCallback| enum - |TessContour| enum |TessProperty| enum |TesselatorObj| :pointer - |TexCoordPointerType| enum |Texture| uint |TextureComponentCount| int - |TextureCoordName| enum |TextureEnvParameter| enum |TextureEnvTarget| enum - |TextureFilterSGIS| enum |TextureGenParameter| enum |TextureNormalModeEXT| - enum |TextureParameterName| enum |TextureTarget| enum |TextureUnit| enum - |UInt16| ushort |UInt32| uint |UInt8| ubyte |VertexAttribEnum| enum - |VertexAttribEnumNV| enum |VertexAttribPointerTypeNV| enum |VertexPointerType| - enum |VertexWeightPointerTypeEXT| enum |Void| void |VoidPointer| :pointer - |ConstVoidPointer| :pointer |WeightPointerTypeARB| enum |WinCoord| int |void| - :void |ArrayObjectPNameATI| enum |ArrayObjectUsageATI| enum |ConstFloat32| - float |ConstInt32| int |ConstUInt32| uint |ConstVoid| void |DataTypeEXT| enum - |FragmentOpATI| enum |GetTexBumpParameterATI| enum |GetVariantValueEXT| enum - |ParameterRangeEXT| enum |PreserveModeATI| enum |ProgramFormatARB| enum - |ProgramTargetARB| enum |ProgramTarget| enum |ProgramPropertyARB| enum - |ProgramStringPropertyARB| enum |ScalarType| enum |SwizzleOpATI| enum - |TexBumpParameterATI| enum |VariantCapEXT| enum - |VertexAttribPointerPropertyARB| enum |VertexAttribPointerTypeARB| enum - |VertexAttribPropertyARB| enum |VertexShaderCoordOutEXT| enum - |VertexShaderOpEXT| enum |VertexShaderParameterEXT| enum - |VertexShaderStorageTypeEXT| enum |VertexShaderTextureUnitParameter| enum - |VertexShaderWriteMaskEXT| enum |VertexStreamATI| enum |PNTrianglesPNameATI| - enum |BufferOffset| intptr |BufferSize| sizeiptr |BufferAccessARB| enum - |BufferOffsetARB| intptr |BufferPNameARB| enum |BufferPointerNameARB| enum - |BufferSizeARB| sizeiptr |BufferTargetARB| enum |BufferUsageARB| enum - |ObjectTypeAPPLE| enum |VertexArrayPNameAPPLE| enum |DrawBufferModeATI| enum - |Half16NV| half |PixelDataRangeTargetNV| enum |GLenum| enum |handleARB| handle - |charARB| char |charPointerARB| :pointer |Int64EXT| int64 |UInt64EXT| uint64) ))) +(|AccumOp| opengl:enum |AlphaFunction| opengl:enum |AttribMask| opengl:bitfield + |BeginMode| opengl:enum |BinormalPointerTypeEXT| opengl:enum + |BlendEquationMode| opengl:enum |BlendEquationModeEXT| opengl:enum + |BlendFuncSeparateParameterEXT| opengl:enum |BlendingFactorDest| opengl:enum + |BlendingFactorSrc| opengl:enum |Boolean| opengl:boolean |BooleanPointer| + :pointer |Char| opengl:char |CharPointer| :pointer |CheckedFloat32| + opengl:float |CheckedInt32| opengl:int |ClampColorTargetARB| opengl:enum + |ClampColorModeARB| opengl:enum |ClampedColorF| opengl:clampf |ClampedFloat32| + opengl:clampf |ClampedFloat64| opengl:clampd |ClampedStencilValue| opengl:int + |ClearBufferMask| opengl:bitfield |ClientAttribMask| opengl:bitfield + |ClipPlaneName| opengl:enum |ColorB| opengl:byte |ColorD| opengl:double + |ColorF| opengl:float |ColorI| opengl:int |ColorIndexValueD| opengl:double + |ColorIndexValueF| opengl:float |ColorIndexValueI| opengl:int + |ColorIndexValueS| opengl:short |ColorIndexValueUB| opengl:ubyte + |ColorMaterialParameter| opengl:enum |ColorPointerType| opengl:enum |ColorS| + opengl:short |ColorTableParameterPName| opengl:enum + |ColorTableParameterPNameSGI| opengl:enum |ColorTableTarget| opengl:enum + |ColorTableTargetSGI| opengl:enum |ColorUB| opengl:ubyte |ColorUI| opengl:uint + |ColorUS| opengl:ushort |CombinerBiasNV| opengl:enum + |CombinerComponentUsageNV| opengl:enum |CombinerMappingNV| opengl:enum + |CombinerParameterNV| opengl:enum |CombinerPortionNV| opengl:enum + |CombinerRegisterNV| opengl:enum |CombinerScaleNV| opengl:enum + |CombinerStageNV| opengl:enum |CombinerVariableNV| opengl:enum + |CompressedTextureARB| opengl:void |ControlPointNV| opengl:void + |ControlPointTypeNV| opengl:enum |ConvolutionParameter| opengl:enum + |ConvolutionParameterEXT| opengl:enum |ConvolutionTarget| opengl:enum + |ConvolutionTargetEXT| opengl:enum |CoordD| opengl:double |CoordF| + opengl:float |CoordI| opengl:int |CoordS| opengl:short |CullFaceMode| + opengl:enum |CullParameterEXT| opengl:enum |DepthFunction| opengl:enum + |DrawBufferMode| opengl:enum |DrawElementsType| opengl:enum + |ElementPointerTypeATI| opengl:enum |EnableCap| opengl:enum |ErrorCode| + opengl:enum |EvalMapsModeNV| opengl:enum |EvalTargetNV| opengl:enum + |FeedbackElement| opengl:float |FeedbackType| opengl:enum |FenceNV| + opengl:uint |FenceConditionNV| opengl:enum |FenceParameterNameNV| opengl:enum + |FfdMaskSGIX| opengl:bitfield |FfdTargetSGIX| opengl:enum |Float32| + opengl:float |Float32Pointer| :pointer |Float64| opengl:double + |Float64Pointer| :pointer |FogParameter| opengl:enum |FogPointerTypeEXT| + opengl:enum |FogPointerTypeIBM| opengl:enum |FragmentLightModelParameterSGIX| + opengl:enum |FragmentLightNameSGIX| opengl:enum |FragmentLightParameterSGIX| + opengl:enum |FramebufferAttachment| opengl:enum |FramebufferTarget| + opengl:enum |FrontFaceDirection| opengl:enum |FunctionPointer| :pointer + |GetColorTableParameterPName| opengl:enum |GetColorTableParameterPNameSGI| + opengl:enum |GetConvolutionParameterPName| opengl:enum + |GetHistogramParameterPName| opengl:enum |GetHistogramParameterPNameEXT| + opengl:enum |GetMapQuery| opengl:enum |GetMinmaxParameterPName| opengl:enum + |GetMinmaxParameterPNameEXT| opengl:enum |GetPName| opengl:enum + |GetPointervPName| opengl:enum |GetTextureParameter| opengl:enum |HintMode| + opengl:enum |HintTarget| opengl:enum |HintTargetPGI| opengl:enum + |HistogramTarget| opengl:enum |HistogramTargetEXT| opengl:enum + |IglooFunctionSelectSGIX| opengl:enum |IglooParameterSGIX| opengl:void + |ImageTransformPNameHP| opengl:enum |ImageTransformTargetHP| opengl:enum + |IndexFunctionEXT| opengl:enum |IndexMaterialParameterEXT| opengl:enum + |IndexPointerType| opengl:enum |Int16| opengl:short |Int32| opengl:int |Int8| + opengl:byte |InterleavedArrayFormat| opengl:enum |LightEnvParameterSGIX| + opengl:enum |LightModelParameter| opengl:enum |LightName| opengl:enum + |LightParameter| opengl:enum |LightTextureModeEXT| opengl:enum + |LightTexturePNameEXT| opengl:enum |LineStipple| opengl:ushort |List| + opengl:uint |ListMode| opengl:enum |ListNameType| opengl:enum + |ListParameterName| opengl:enum |LogicOp| opengl:enum |MapAttribParameterNV| + opengl:enum |MapParameterNV| opengl:enum |MapTarget| opengl:enum |MapTargetNV| + opengl:enum |MapTypeNV| opengl:enum |MaskedColorIndexValueF| opengl:float + |MaskedColorIndexValueI| opengl:uint |MaskedStencilValue| opengl:uint + |MaterialFace| opengl:enum |MaterialParameter| opengl:enum + |MatrixIndexPointerTypeARB| opengl:enum |MatrixMode| opengl:enum + |MatrixTransformNV| opengl:enum |MeshMode1| opengl:enum |MeshMode2| + opengl:enum |MinmaxTarget| opengl:enum |MinmaxTargetEXT| opengl:enum + |NormalPointerType| opengl:enum |NurbsCallback| opengl:enum |NurbsObj| + :pointer |NurbsProperty| opengl:enum |NurbsTrim| opengl:enum + |OcclusionQueryParameterNameNV| opengl:enum |PixelCopyType| opengl:enum + |PixelFormat| opengl:enum |PixelInternalFormat| opengl:enum |PixelMap| + opengl:enum |PixelStoreParameter| opengl:enum |PixelTexGenModeSGIX| + opengl:enum |PixelTexGenParameterNameSGIS| opengl:enum + |PixelTransferParameter| opengl:enum |PixelTransformPNameEXT| opengl:enum + |PixelTransformTargetEXT| opengl:enum |PixelType| opengl:enum + |PointParameterNameARB| opengl:enum |PolygonMode| opengl:enum |ProgramNV| + opengl:uint |ProgramCharacterNV| opengl:ubyte |ProgramParameterNV| opengl:enum + |ProgramParameterPName| opengl:enum |QuadricCallback| opengl:enum + |QuadricDrawStyle| opengl:enum |QuadricNormal| opengl:enum |QuadricObj| + :pointer |QuadricOrientation| opengl:enum |ReadBufferMode| opengl:enum + |RenderbufferTarget| opengl:enum |RenderingMode| opengl:enum + |ReplacementCodeSUN| opengl:uint |ReplacementCodeTypeSUN| opengl:enum + |SamplePassARB| opengl:enum |SamplePatternEXT| opengl:enum |SamplePatternSGIS| + opengl:enum |SecondaryColorPointerTypeIBM| opengl:enum |SelectName| + opengl:uint |SeparableTarget| opengl:enum |SeparableTargetEXT| opengl:enum + |ShadingModel| opengl:enum |SizeI| opengl:sizei |SpriteParameterNameSGIX| + opengl:enum |StencilFunction| opengl:enum |StencilFaceDirection| opengl:enum + |StencilOp| opengl:enum |StencilValue| opengl:int |String| opengl:string + |StringName| opengl:enum |TangentPointerTypeEXT| opengl:enum |TessCallback| + opengl:enum |TessContour| opengl:enum |TessProperty| opengl:enum + |TesselatorObj| :pointer |TexCoordPointerType| opengl:enum |Texture| + opengl:uint |TextureComponentCount| opengl:int |TextureCoordName| opengl:enum + |TextureEnvParameter| opengl:enum |TextureEnvTarget| opengl:enum + |TextureFilterSGIS| opengl:enum |TextureGenParameter| opengl:enum + |TextureNormalModeEXT| opengl:enum |TextureParameterName| opengl:enum + |TextureTarget| opengl:enum |TextureUnit| opengl:enum |UInt16| opengl:ushort + |UInt32| opengl:uint |UInt8| opengl:ubyte |VertexAttribEnum| opengl:enum + |VertexAttribEnumNV| opengl:enum |VertexAttribPointerTypeNV| opengl:enum + |VertexPointerType| opengl:enum |VertexWeightPointerTypeEXT| opengl:enum + |Void| opengl:void |VoidPointer| :pointer |ConstVoidPointer| :pointer + |WeightPointerTypeARB| opengl:enum |WinCoord| opengl:int |void| :void + |ArrayObjectPNameATI| opengl:enum |ArrayObjectUsageATI| opengl:enum + |ConstFloat32| opengl:float |ConstInt32| opengl:int |ConstUInt32| opengl:uint + |ConstVoid| opengl:void |DataTypeEXT| opengl:enum |FragmentOpATI| opengl:enum + |GetTexBumpParameterATI| opengl:enum |GetVariantValueEXT| opengl:enum + |ParameterRangeEXT| opengl:enum |PreserveModeATI| opengl:enum + |ProgramFormatARB| opengl:enum |ProgramTargetARB| opengl:enum |ProgramTarget| + opengl:enum |ProgramPropertyARB| opengl:enum |ProgramStringPropertyARB| + opengl:enum |ScalarType| opengl:enum |SwizzleOpATI| opengl:enum + |TexBumpParameterATI| opengl:enum |VariantCapEXT| opengl:enum + |VertexAttribPointerPropertyARB| opengl:enum |VertexAttribPointerTypeARB| + opengl:enum |VertexAttribPropertyARB| opengl:enum |VertexShaderCoordOutEXT| + opengl:enum |VertexShaderOpEXT| opengl:enum |VertexShaderParameterEXT| + opengl:enum |VertexShaderStorageTypeEXT| opengl:enum + |VertexShaderTextureUnitParameter| opengl:enum |VertexShaderWriteMaskEXT| + opengl:enum |VertexStreamATI| opengl:enum |PNTrianglesPNameATI| opengl:enum + |BufferOffset| opengl:intptr |BufferSize| opengl:sizeiptr |BufferAccessARB| + opengl:enum |BufferOffsetARB| opengl:intptr |BufferPNameARB| opengl:enum + |BufferPointerNameARB| opengl:enum |BufferSizeARB| opengl:sizeiptr + |BufferTargetARB| opengl:enum |BufferUsageARB| opengl:enum |ObjectTypeAPPLE| + opengl:enum |VertexArrayPNameAPPLE| opengl:enum |DrawBufferModeATI| + opengl:enum |Half16NV| opengl:half |PixelDataRangeTargetNV| opengl:enum + |GLenum| opengl:enum |handleARB| opengl:handle |charARB| opengl:char + |charPointerARB| :pointer |Int64EXT| opengl:int64 |UInt64EXT| opengl:uint64) ))) (labels ((c-name (func-spec) (first (first func-spec))) (lisp-name (func-spec) (second (first func-spec))) (freturn (func-spec) (first (getf (rest func-spec) :return))) @@ -4693,10 +4741,10 @@ blend-color-ext )) ;; so doing it this way is consistent with the C-interface, though more dangerous #| (or (integerp (getf arg :size)) - (and (symbolp (getf arg :size)) - (find-if #'(lambda (other-arg) - (eql (getf arg :size) (final-arg-name other-arg))) - args)))|# + (and (symbolp (getf arg :size)) + (find-if #'(lambda (other-arg) + (eql (getf arg :size) (final-arg-name other-arg))) + args)))|# ;; our own hook (not (getf arg :wrapped))))) (gl-function-definition (func-spec &optional (c-prefix "gl") (lisp-prefix '#:||)) @@ -4736,16 +4784,16 @@ blend-color-ext )) (unwind-protect (prog1 #| as input values are set above, we don't use this now (and above is a prog1, it was prog2 before) - ;; custom coersion of input values, before call ; - ,(when (eql (getf arg :direction) :in) - `(cond - ((listp ,original-array-name) - (loop for i upfrom 0 for e in ,original-array-name - do (setf (mem-aref ,array-name ',(arg-element-type arg) i) e))) - ((vectorp ,original-array-name) - (loop for i upfrom 0 for e across ,original-array-name - do (setf (mem-aref ,array-name ',(arg-element-type arg) i) e))))) - |# + ;; custom coersion of input values, before call ; ; + ,(when (eql (getf arg :direction) :in) + `(cond + ((listp ,original-array-name) + (loop for i upfrom 0 for e in ,original-array-name + do (setf (mem-aref ,array-name ',(arg-element-type arg) i) e))) + ((vectorp ,original-array-name) + (loop for i upfrom 0 for e across ,original-array-name + do (setf (mem-aref ,array-name ',(arg-element-type arg) i) e))))) + |# ;; recurse in case there are more ,(expand-a-wrapping func-spec final-content) ;; custom coersion of output values, after call @@ -4756,14 +4804,14 @@ blend-color-ext )) (ce ,original-array-name (cdr ce))) ((not ce)) #|((or (not ce) - (>= i ,(getf arg :size))))|# + (>= i ,(getf arg :size))))|# (setf (car ce) (mem-aref ,array-name ',(arg-element-type arg) i)))) ((vectorp ,original-array-name) (do ((i 0 (1+ i))) ((>= i (length ,original-array-name))) #|((or (>= i (length ,original-array-name)) - (>= i ,(getf arg :size))))|# + (>= i ,(getf arg :size))))|# (setf (aref ,original-array-name i) (mem-aref ,array-name ',(arg-element-type arg) i))))))) (foreign-free ,array-name))) diff --git a/src/opengl-template.lisp b/src/opengl-template.lisp index 3e21960..c408068 100644 --- a/src/opengl-template.lisp +++ b/src/opengl-template.lisp @@ -1,10 +1,14 @@ (defpackage #:opengl (:use #:cffi #:cl) (:nicknames #:gl) - (:shadow boolean byte float char string) + (:shadow #:boolean #:byte #:float #:char #:string) (:export - enum boolean bitfield byte short int sizei ubyte ushort uint float clampf - double clampd void uint64 int64 intptr sizeiptr handle char string half + #:enum #:boolean #:bitfield #:byte #:short #:int #:sizei #:ubyte #:ushort #:uint + #:float #:clampf #:double #:clampd #:void #:uint64 #:int64 + #:intptr #:sizeiptr + #:handle + #:char #:string + #:half @EXPORTS@)) (in-package #:opengl) @@ -51,7 +55,21 @@ (defctype half :unsigned-short) ; this is how glext.h defines it anyway + (eval-when (:compile-toplevel :load-toplevel :execute) + + (defmethod cffi:expand-to-foreign (value (type (eql 'boolean))) + `(if ,value gl:+true+ gl:+false+)) + + (defmethod cffi:expand-from-foreign (value (type (eql 'boolean))) + `(not (= ,value gl:+false+))) + + (defmethod cffi:expand-to-foreign (value (type (eql 'float))) + `(coerce ,value 'single-float)) + + (defmethod cffi:expand-to-foreign (value (type (eql 'double))) + `(coerce ,value 'double-float)) + (let ((type-maps (quote @TYPE_MAPS@))) (labels ((c-name (func-spec) (first (first func-spec))) (lisp-name (func-spec) (second (first func-spec))) @@ -128,7 +146,7 @@ (unwind-protect (prog1 #| as input values are set above, we don't use this now (and above is a prog1, it was prog2 before) - ;; custom coersion of input values, before call ; + ;; custom coersion of input values, before call ; ; ,(when (eql (getf arg :direction) :in) `(cond ((listp ,original-array-name) @@ -148,14 +166,14 @@ (ce ,original-array-name (cdr ce))) ((not ce)) #|((or (not ce) - (>= i ,(getf arg :size))))|# + (>= i ,(getf arg :size))))|# (setf (car ce) (mem-aref ,array-name ',(arg-element-type arg) i)))) ((vectorp ,original-array-name) (do ((i 0 (1+ i))) ((>= i (length ,original-array-name))) #|((or (>= i (length ,original-array-name)) - (>= i ,(getf arg :size))))|# + (>= i ,(getf arg :size))))|# (setf (aref ,original-array-name i) (mem-aref ,array-name ',(arg-element-type arg) i))))))) (foreign-free ,array-name))) -- 2.11.4.GIT