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