5 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
6 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
8 ;;; Figl is free software: you can redistribute it and/or modify it
9 ;;; under the terms of the GNU Lesser General Public License as
10 ;;; published by the Free Software Foundation, either version 3 of the
11 ;;; License, or (at your option) any later version.
13 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
14 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15 ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
16 ;;; Public License for more details.
18 ;;; You should have received a copy of the GNU Lesser General Public
19 ;;; License along with this program. If not, see
20 ;;; <http://www.gnu.org/licenses/>.
24 ;; Generate Scheme enumerations for the GL API.
28 (use-modules (figl parse)
32 ((srfi srfi-1) #:select (append-map))
33 (srfi srfi-69) ; alist->hash-table
40 (print-disable 'escape-newlines)
42 (define (list-intersperse src-l elem)
43 (if (null? src-l) src-l
44 (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
45 (if (null? l) (reverse dest)
46 (loop (cdr l) (cons (car l) (cons elem dest)))))))
48 (define (module-name->scm-name mod-name)
49 (string-join (list (abs-top-srcdir)
51 (symbol->string mod-name)
55 (define (module-name->texi-name mod-name)
57 (in-vicinity (abs-top-srcdir) "doc")
58 (string-append "low-level-" (symbol->string mod-name) "-enums.texi")))
60 (define (strip-bit name)
61 (let ((str (symbol->string name)))
63 ((string-suffix? "-bit" str)
64 (string->symbol (substring str 0 (- (string-length str) 4))))
65 ((string-suffix? "-bits" str)
66 (string->symbol (substring str 0 (- (string-length str) 5))))
69 (define type-map-table (make-parameter #f))
71 (define (use-type-map tm)
72 (type-map-table (alist->hash-table tm eq? hashq)))
74 (define (type-map type)
75 (hash-table-ref/default (type-map-table) type #f))
77 ;; TODO: Some guesswork is applied here due to inconsistency between
78 ;; the various .spec and type map files. Ideally, the type map can
79 ;; determine whether a type is a bitfield or enum. However, some
80 ;; definitions in enum.spec use a different name to those in gl.spec
81 ;; and gl.tm. For example, BufferAccessMask is known as
82 ;; ARB_map_buffer_range in enum.spec.
84 ;; Perhaps provide an additional map to translate these odd enum.spec
87 (define (bitfield? enum)
88 (let* ((type (make-gl-param-type (gl-enumeration-category enum)
91 (mapped-type (type-map type)))
93 (eq? (gl-param-type-type mapped-type) 'GLbitfield)
94 ;; otherwise, resort to guesswork
95 (and-map (match-lambda ((name . value) (strip-bit name)))
96 (gl-enumeration-values enum)))))
98 (define (write-scm mod-name enums port)
100 ;;; figl -*- mode: scheme; coding: utf-8 -*-
101 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
102 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
104 ;;; Figl is free software: you can redistribute it and/or modify it
105 ;;; under the terms of the GNU Lesser General Public License as
106 ;;; published by the Free Software Foundation, either version 3 of the
107 ;;; License, or (at your option) any later version.
109 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
110 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
111 ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
112 ;;; Public License for more details.
114 ;;; You should have received a copy of the GNU Lesser General Public
115 ;;; License along with this program. If not, see
116 ;;; <http://www.gnu.org/licenses/>.
118 ;;; Derived from the API specifications at www.opengl.org/registry/api/.
120 ;;; Automatically generated; you probably don't want to edit this. To
121 ;;; update, run \"make update-enums\" in the top-level build tree.
126 `(define-module (figl ,mod-name enums)
127 #:use-module (figl runtime)
128 #:export ,(map gl-enumeration-category enums))
135 `(define-bitfield ,(gl-enumeration-category enum)
137 ((name . value) (list (or (strip-bit name) name)
139 (gl-enumeration-values enum)))
140 `(define-enumeration ,(gl-enumeration-category enum)
142 ((name . value) (list name value)))
143 (gl-enumeration-values enum))))
148 (define (write-texi mod-name enums port)
149 ;; FIXME: stexi->texi seems to have some issues with multiline
150 ;; comments, otherwise this notice should appear in the fragment
151 ;; itself. Maybe I am not doing it right.
154 "@c This is part of the Figl Reference Manual.\n"
155 "@c Copyright (c) 2013 Andy Wingo and others\n"
156 "@c See the file figl.texi for copying conditions.\n")
161 (para "The functions from this section may be had by loading "
163 (example "(use-modules (figl " ,(object->string mod-name) " enums)")
167 `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
168 (arguments "bit..."))
170 "Bitfield constructor. The symbolic " (var "bit")
171 " arguments are replaced with their corresponding numeric "
172 "values and combined with " (code "logior") " at "
173 "compile-time. The symbolic arguments known to this "
174 "bitfield constructor are:")
178 `(code ,(symbol->string (or (strip-bit name)
180 (map car (gl-enumeration-values enum)))
183 `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
186 "Enumerated value. The symbolic " (var "enum") " argument "
187 "is replaced with its corresponding numeric value at "
188 "compile-time. The symbolic arguments known to this "
189 "enumerated value form are:")
192 (map (lambda (name) `(code ,(symbol->string name)))
193 (map car (gl-enumeration-values enum)))
199 (define (write-enumerations mod-name enums)
200 (call-with-output-file (module-name->scm-name mod-name)
202 (write-scm mod-name enums port)))
203 (call-with-output-file (module-name->texi-name mod-name)
205 (write-texi mod-name enums port))))
208 (use-type-map (parse-gl-type-map "gl.tm"))
209 (write-enumerations 'gl (parse-gl-enumerations "enum.spec"))
210 (use-type-map (parse-gl-type-map "glx.tm"))
211 (write-enumerations 'glx (parse-gl-enumerations "glxenum.spec")))
214 (apply main (command-line)))