Commit | Line | Data |
---|---|---|
092cacd7 AW |
1 | #!/usr/bin/env guile |
2 | !# | |
3 | ||
4 | (use-modules (figl parse) | |
5 | (figl config) | |
6 | (ice-9 match) | |
7 | (sxml fold) | |
8 | ((srfi srfi-1) #:select (append-map)) | |
94e407a1 | 9 | (srfi srfi-69) ; alist->hash-table |
092cacd7 AW |
10 | (texinfo serialize) |
11 | (texinfo plain-text) | |
12 | (ice-9 pretty-print)) | |
13 | ||
14 | (setlocale LC_ALL "") | |
15 | ||
16 | (print-disable 'escape-newlines) | |
17 | ||
18 | (define (list-intersperse src-l elem) | |
19 | (if (null? src-l) src-l | |
20 | (let loop ((l (cdr src-l)) (dest (cons (car src-l) '()))) | |
21 | (if (null? l) (reverse dest) | |
22 | (loop (cdr l) (cons (car l) (cons elem dest))))))) | |
23 | ||
24 | (define (module-name->scm-name mod-name) | |
25 | (string-join (list (abs-top-srcdir) | |
26 | "figl" | |
27 | (symbol->string mod-name) | |
28 | "enums.scm") | |
29 | "/")) | |
30 | ||
092cacd7 AW |
31 | (define (module-name->texi-name mod-name) |
32 | (in-vicinity | |
33 | (in-vicinity (abs-top-srcdir) "doc") | |
029af955 AW |
34 | (string-append "low-level-" (symbol->string mod-name) "-enums.texi"))) |
35 | ||
36 | (define (strip-bit name) | |
37 | (let ((str (symbol->string name))) | |
38 | (cond | |
39 | ((string-suffix? "-bit" str) | |
40 | (string->symbol (substring str 0 (- (string-length str) 4)))) | |
41 | ((string-suffix? "-bits" str) | |
42 | (string->symbol (substring str 0 (- (string-length str) 5)))) | |
43 | (else #f)))) | |
44 | ||
94e407a1 DH |
45 | (define type-map-table (make-parameter #f)) |
46 | ||
47 | (define (use-type-map tm) | |
48 | (type-map-table (alist->hash-table tm eq? hashq))) | |
49 | ||
50 | (define (type-map type) | |
51 | (hash-table-ref/default (type-map-table) type #f)) | |
52 | ||
53 | ;; TODO: Some guesswork is applied here due to inconsistency between | |
54 | ;; the various .spec and type map files. Ideally, the type map can | |
55 | ;; determine whether a type is a bitfield or enum. However, some | |
56 | ;; definitions in enum.spec use a different name to those in gl.spec | |
57 | ;; and gl.tm. For example, BufferAccessMask is known as | |
58 | ;; ARB_map_buffer_range in enum.spec. | |
59 | ;; | |
60 | ;; Perhaps provide an additional map to translate these odd enum.spec | |
61 | ;; names. | |
62 | ||
029af955 | 63 | (define (bitfield? enum) |
94e407a1 DH |
64 | (let* ((type (make-gl-param-type (gl-enumeration-category enum) |
65 | 'in | |
66 | 'value)) | |
67 | (mapped-type (type-map type))) | |
68 | (if mapped-type | |
69 | (eq? (gl-param-type-type mapped-type) 'GLbitfield) | |
70 | ;; otherwise, resort to guesswork | |
71 | (and-map (match-lambda ((name . value) (strip-bit name))) | |
72 | (gl-enumeration-values enum))))) | |
092cacd7 AW |
73 | |
74 | (define (write-scm mod-name enums port) | |
75 | (display "\ | |
76 | ;;; figl -*- mode: scheme; coding: utf-8 -*- | |
77 | ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com> | |
78 | ;;; | |
79 | ;;; Figl is free software: you can redistribute it and/or modify it | |
80 | ;;; under the terms of the GNU Lesser General Public License as | |
81 | ;;; published by the Free Software Foundation, either version 3 of the | |
82 | ;;; License, or (at your option) any later version. | |
83 | ;;; | |
84 | ;;; Figl is distributed in the hope that it will be useful, but WITHOUT | |
85 | ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | |
86 | ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General | |
87 | ;;; Public License for more details. | |
88 | ;;; | |
89 | ;;; You should have received a copy of the GNU Lesser General Public | |
90 | ;;; License along with this program. If not, see | |
91 | ;;; <http://www.gnu.org/licenses/>. | |
92 | ;;; | |
93 | ;;; Derived from the API specifications at www.opengl.org/registry/api/. | |
94 | ;;; | |
95 | ;;; Automatically generated; you probably don't want to edit this. To | |
96 | ;;; update, run \"make update-enums\" in the top-level build tree. | |
97 | ;;; | |
98 | ||
99 | " port) | |
100 | (pretty-print | |
101 | `(define-module (figl ,mod-name enums) | |
102 | #:use-module (figl runtime) | |
103 | #:export ,(map gl-enumeration-category enums)) | |
104 | port) | |
105 | (newline port) | |
106 | (for-each | |
107 | (lambda (enum) | |
092cacd7 AW |
108 | (pretty-print |
109 | (if (bitfield? enum) | |
110 | `(define-bitfield ,(gl-enumeration-category enum) | |
111 | ,@(map (match-lambda | |
94e407a1 DH |
112 | ((name . value) (list (or (strip-bit name) name) |
113 | value))) | |
092cacd7 AW |
114 | (gl-enumeration-values enum))) |
115 | `(define-enumeration ,(gl-enumeration-category enum) | |
116 | ,@(map (match-lambda | |
117 | ((name . value) (list name value))) | |
118 | (gl-enumeration-values enum)))) | |
119 | port) | |
120 | (newline port)) | |
121 | enums)) | |
122 | ||
029af955 | 123 | (define (write-texi mod-name enums port) |
092cacd7 AW |
124 | (display |
125 | (stexi->texi | |
126 | `(*fragment* | |
127 | (para "The functions from this section may be had by loading " | |
128 | "the module:") | |
029af955 | 129 | (example "(use-modules (figl " ,(object->string mod-name) " enums)") |
092cacd7 | 130 | ,@(map |
029af955 AW |
131 | (lambda (enum) |
132 | (if (bitfield? enum) | |
133 | `(defmac (% (name ,(symbol->string (gl-enumeration-category enum))) | |
134 | (arguments "bit...")) | |
135 | (para | |
136 | "Bitfield constructor. The symbolic " (var "bit") | |
137 | " arguments are replaced with their corresponding numeric " | |
138 | "values and combined with " (code "logior") " at " | |
139 | "compile-time. The symbolic arguments known to this " | |
140 | "bitfield constructor are:") | |
141 | (para | |
142 | ,@(list-intersperse | |
143 | (map (lambda (name) | |
94e407a1 DH |
144 | `(code ,(symbol->string (or (strip-bit name) |
145 | name)))) | |
029af955 AW |
146 | (map car (gl-enumeration-values enum))) |
147 | ", ") | |
148 | ".")) | |
149 | `(defmac (% (name ,(symbol->string (gl-enumeration-category enum))) | |
150 | (arguments "enum")) | |
151 | (para | |
c7b5f548 | 152 | "Enumerated value. The symbolic " (var "enum") " argument " |
029af955 AW |
153 | "is replaced with its corresponding numeric value at " |
154 | "compile-time. The symbolic arguments known to this " | |
155 | "enumerated value form are:") | |
156 | (para | |
157 | ,@(list-intersperse | |
158 | (map (lambda (name) `(code ,(symbol->string name))) | |
159 | (map car (gl-enumeration-values enum))) | |
160 | ", ") | |
161 | ".")))) | |
162 | enums))) | |
092cacd7 AW |
163 | port)) |
164 | ||
165 | (define (write-enumerations mod-name enums) | |
166 | (call-with-output-file (module-name->scm-name mod-name) | |
167 | (lambda (port) | |
168 | (write-scm mod-name enums port))) | |
092cacd7 AW |
169 | (call-with-output-file (module-name->texi-name mod-name) |
170 | (lambda (port) | |
171 | (write-texi mod-name enums port)))) | |
172 | ||
173 | (define* (main arg0) | |
94e407a1 | 174 | (use-type-map (parse-gl-type-map "gl.tm")) |
704372ea | 175 | (write-enumerations 'gl (parse-gl-enumerations "enum.spec")) |
94e407a1 | 176 | (use-type-map (parse-gl-type-map "glx.tm")) |
704372ea | 177 | (write-enumerations 'glx (parse-gl-enumerations "glxenum.spec"))) |
092cacd7 AW |
178 | |
179 | (when (batch-mode?) | |
180 | (apply main (command-line))) |