figl/gl/types.scm

   1 ;;; figl
   2 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
   3 ;;;
   4 ;;; Figl is free software: you can redistribute it and/or modify it
   5 ;;; under the terms of the GNU Lesser General Public License as
   6 ;;; published by the Free Software Foundation, either version 3 of the
   7 ;;; License, or (at your option) any later version.
   8 ;;;
   9 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  10 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  12 ;;; Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU Lesser General Public
  15 ;;; License along with this program.  If not, see
  16 ;;; <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19 ;;
  20 ;; Mappings from OpenGL to FFI types.
  21 ;;
  22 ;;; Code:
  23
  24 (define-module (figl gl types)
  25   #:use-module (figl runtime)
  26   #:use-module (rnrs bytevectors)
  27   #:use-module ((system foreign) #:renamer (symbol-prefix-proc 'ffi:))
  28   #:export (void
  29             GLboolean
  30             GLbyte
  31             GLubyte
  32             GLchar
  33             GLshort
  34             GLushort
  35             GLint
  36             GLuint
  37             GLsizei
  38             GLenum
  39             GLintptr
  40             GLsizeiptr
  41             GLbitfield
  42             GLfloat
  43             GLclampf
  44             GLdouble
  45             GLclampd
  46
  47             GLboolean-*
  48             GLbyte-*
  49             GLubyte-*
  50             GLchar-*
  51             GLshort-*
  52             GLushort-*
  53             GLint-*
  54             GLuint-*
  55             GLsizei-*
  56             GLenum-*
  57             GLfloat-*
  58             GLclampf-*
  59             GLdouble-*
  60             GLclampd-*
  61             GLvoid-*
  62             GLvoid-**
  63
  64             const-GLboolean-*
  65             const-GLbyte-*
  66             const-GLubyte-*
  67             const-GLubyte*
  68             const-GLchar-*
  69             const-GLchar-**
  70             const-GLshort-*
  71             const-GLushort-*
  72             const-GLint-*
  73             const-GLuint-*
  74             const-GLsizei-*
  75             const-GLenum-*
  76             const-GLfloat-*
  77             const-GLclampf-*
  78             const-GLdouble-*
  79             const-GLclampd-*
  80             const-GLvoid-*
  81             const-GLvoid-**
  82             void-*))
  83
  84 ;; TODO: Taken from Mesa headers for some types below.  Not clear what
  85 ;; these types are on other platforms.
  86 (define %ptr ffi:ptrdiff_t)
  87
  88 (define-simple-foreign-type void ffi:void)
  89 (define-simple-foreign-type GLbyte ffi:int8)
  90 (define-simple-foreign-type GLubyte ffi:uint8)
  91 (define-simple-foreign-type GLchar ffi:int8)
  92 (define-simple-foreign-type GLshort ffi:int16)
  93 (define-simple-foreign-type GLushort ffi:uint16)
  94 (define-simple-foreign-type GLint ffi:int32)
  95 (define-simple-foreign-type GLuint ffi:uint32)
  96 (define-simple-foreign-type GLsizei ffi:int32)
  97 (define-simple-foreign-type GLenum ffi:uint32)
  98 (define-simple-foreign-type GLintptr %ptr)
  99 (define-simple-foreign-type GLsizeiptr %ptr)
 100 (define-simple-foreign-type GLbitfield ffi:uint32)
 101 (define-simple-foreign-type GLfloat ffi:float)
 102 (define-simple-foreign-type GLclampf ffi:float)
 103 (define-simple-foreign-type GLdouble ffi:double)
 104 (define-simple-foreign-type GLclampd ffi:double)
 105 (define-simple-foreign-type GLvoid-* '*)
 106 (define-simple-foreign-type void-* '*)
 107 (define-simple-foreign-type const-GLvoid-* '*)
 108
 109 (define GL_FALSE 0)
 110 (define GL_TRUE 1)
 111
 112 (define-foreign-type GLboolean ffi:uint8
 113   (lambda (x) (if x GL_TRUE GL_FALSE))
 114   (lambda (x) (eqv? x GL_TRUE)))
 115
 116 (define (coerce-array-pointer x)
 117   (cond
 118    ((ffi:pointer? x)
 119     x)
 120    ((bytevector? x)
 121     (ffi:bytevector->pointer x))
 122    ;; TODO: (typed-array? x element-type)
 123    ((not x)
 124     ffi:%null-pointer)
 125    (else
 126     (error "unhandled array-pointer type" x))))
 127
 128 (define-syntax define-array-foreign-type
 129   (syntax-rules ()
 130     ((_ name element-type)
 131      (define-foreign-type name '*
 132        coerce-array-pointer
 133        (lambda (x) x)))))
 134
 135 (define-array-foreign-type GLboolean-* GLboolean)
 136 (define-array-foreign-type GLbyte-* GLbyte)
 137 (define-array-foreign-type GLubyte-* GLubyte)
 138 (define-array-foreign-type GLchar-* GLchar)
 139 (define-array-foreign-type GLshort-* GLshort)
 140 (define-array-foreign-type GLushort-* GLushort)
 141 (define-array-foreign-type GLint-* GLint)
 142 (define-array-foreign-type GLuint-* GLuint)
 143 (define-array-foreign-type GLsizei-* GLsizei)
 144 (define-array-foreign-type GLenum-* GLenum)
 145 (define-array-foreign-type GLfloat-* GLfloat)
 146 (define-array-foreign-type GLclampf-* GLclampf)
 147 (define-array-foreign-type GLdouble-* GLdouble)
 148 (define-array-foreign-type GLclampd-* GLclampd)
 149
 150 (define-array-foreign-type const-GLboolean-* GLboolean)
 151 (define-array-foreign-type const-GLbyte-* GLbyte)
 152 (define-array-foreign-type const-GLubyte-* GLubyte)
 153 (define-array-foreign-type const-GLshort-* GLshort)
 154 (define-array-foreign-type const-GLushort-* GLushort)
 155 (define-array-foreign-type const-GLint-* GLint)
 156 (define-array-foreign-type const-GLuint-* GLuint)
 157 (define-array-foreign-type const-GLsizei-* GLsizei)
 158 (define-array-foreign-type const-GLenum-* GLenum)
 159 (define-array-foreign-type const-GLfloat-* GLfloat)
 160 (define-array-foreign-type const-GLclampf-* GLclampf)
 161 (define-array-foreign-type const-GLdouble-* GLdouble)
 162 (define-array-foreign-type const-GLclampd-* GLclampd)
 163 (define-array-foreign-type const-GLvoid-* GLvoid)
 164
 165 (define-foreign-type const-GLchar-* '*
 166   ffi:string->pointer
 167   ffi:pointer->string)
 168
 169 ;; Functions with these types will need special help.
 170 (define-simple-foreign-type GLvoid-** '*)
 171 (define-simple-foreign-type const-GLchar-** '*)
 172 (define-simple-foreign-type const-GLvoid-** '*)
 173
 174 ;; TODO: Hacked for a typo in glGetString.xml.
 175 (define-array-foreign-type const-GLubyte* GLubyte)