generate glx enums

[clinton/guile-figl.git] / maint / update-enumerations

#!/usr/bin/env guile
!#

(use-modules (figl parse)
             (figl config)
             (ice-9 match)
             (sxml fold)
             ((srfi srfi-1) #:select (append-map))
             (texinfo serialize)
             (texinfo plain-text)
             (ice-9 pretty-print))

(setlocale LC_ALL "")

(print-disable 'escape-newlines)

(define (list-intersperse src-l elem)
  (if (null? src-l) src-l
      (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
        (if (null? l) (reverse dest)
            (loop (cdr l) (cons (car l) (cons elem dest)))))))

(define (module-name->scm-name mod-name)
  (string-join (list (abs-top-srcdir)
                     "figl"
                     (symbol->string mod-name)
                     "enums.scm")
               "/"))

(define (module-name->texi-name mod-name)
  (in-vicinity
   (in-vicinity (abs-top-srcdir) "doc")
   (string-append "low-level-" (symbol->string mod-name) "-enums.texi")))

(define (strip-bit name)
  (let ((str (symbol->string name)))
    (cond
     ((string-suffix? "-bit" str)
      (string->symbol (substring str 0 (- (string-length str) 4))))
     ((string-suffix? "-bits" str)
      (string->symbol (substring str 0 (- (string-length str) 5))))
     (else #f))))

(define (bitfield? enum)
  (and-map (match-lambda ((name . value) (strip-bit name)))
           (gl-enumeration-values enum)))

(define (write-scm mod-name enums port)
  (display "\
;;; figl                           -*- mode: scheme; coding: utf-8 -*-
;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
;;;
;;; Figl is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;; 
;;; Figl is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
;;; Public License for more details.
;;; 
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; Derived from the API specifications at www.opengl.org/registry/api/.
;;;
;;; Automatically generated; you probably don't want to edit this.  To
;;; update, run \"make update-enums\" in the top-level build tree.
;;;

" port)
  (pretty-print
   `(define-module (figl ,mod-name enums)
      #:use-module (figl runtime)
      #:export ,(map gl-enumeration-category enums))
   port)
  (newline port)
  (for-each
   (lambda (enum)
     (pretty-print
      (if (bitfield? enum)
          `(define-bitfield ,(gl-enumeration-category enum)
             ,@(map (match-lambda
                     ((name . value) (list (strip-bit name) value)))
                    (gl-enumeration-values enum)))
          `(define-enumeration ,(gl-enumeration-category enum)
             ,@(map (match-lambda
                     ((name . value) (list name value)))
                    (gl-enumeration-values enum))))
      port)
     (newline port))
   enums))

(define (write-texi mod-name enums port)
  (display
   (stexi->texi
    `(*fragment*
      (para "The functions from this section may be had by loading "
            "the module:")
      (example "(use-modules (figl " ,(object->string mod-name) " enums)")
      ,@(map
         (lambda (enum)
           (if (bitfield? enum)
               `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
                           (arguments "bit..."))
                  (para
                   "Bitfield constructor.  The symbolic " (var "bit")
                   " arguments are replaced with their corresponding numeric "
                   "values and combined with " (code "logior") " at "
                   "compile-time.  The symbolic arguments known to this "
                   "bitfield constructor are:")
                  (para
                   ,@(list-intersperse
                      (map (lambda (name)
                             `(code ,(symbol->string (strip-bit name))))
                           (map car (gl-enumeration-values enum)))
                     ", ")
                   "."))
               `(defmac (% (name ,(symbol->string (gl-enumeration-category enum)))
                           (arguments "enum"))
                  (para
                   "Enumerated value.  The symbolic " (var "enum") "argument "
                   "is replaced with its corresponding numeric value at "
                   "compile-time.  The symbolic arguments known to this "
                   "enumerated value form are:")
                  (para
                   ,@(list-intersperse
                      (map (lambda (name) `(code ,(symbol->string name)))
                           (map car (gl-enumeration-values enum)))
                     ", ")
                   "."))))
         enums)))
   port))

(define (write-enumerations mod-name enums)
  (call-with-output-file (module-name->scm-name mod-name)
    (lambda (port)
      (write-scm mod-name enums port)))
  (call-with-output-file (module-name->texi-name mod-name)
    (lambda (port)
      (write-texi mod-name enums port))))

(define* (main arg0)
  (write-enumerations 'gl (parse-gl-enumerations "enum.spec"))
  (write-enumerations 'glx (parse-gl-enumerations "glxenum.spec")))

(when (batch-mode?)
  (apply main (command-line)))