maint/update-low-level-bindings

   1 #!/usr/bin/env guile
   2 !#
   3
   4 (use-modules (figl parse)
   5              (figl config)
   6              (sxml fold)
   7              ((srfi srfi-1) #:select (append-map))
   8              (texinfo serialize)
   9              (texinfo plain-text)
  10              (ice-9 pretty-print))
  11
  12 (setlocale LC_ALL "")
  13
  14 (print-disable 'escape-newlines)
  15
  16 (define (module-name->scm-name mod-name)
  17   (in-vicinity
  18    (abs-top-srcdir)
  19    (string-append (string-join (map symbol->string mod-name) "/")
  20                   ".scm")))
  21
  22 (define (module-name->texi-name mod-name)
  23   (in-vicinity
  24    (in-vicinity (abs-top-srcdir) "doc")
  25    (string-append (string-join (map symbol->string (cdr mod-name)) "-")
  26                   ".texi")))
  27
  28 (define (unique-copyrights defs)
  29   (let lp ((in defs) (out '()))
  30     (if (null? in)
  31         (reverse out)
  32         (let ((copyright (gl-definition-copyright (car in))))
  33           (lp (cdr in)
  34               (if (member copyright out)
  35                   out
  36                   (cons copyright out)))))))
  37
  38 (define (write-scm mod-name defs port)
  39   (display "\
  40 ;;; figl                           -*- mode: scheme; coding: utf-8 -*-
  41 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
  42 ;;;
  43 ;;; Figl is free software: you can redistribute it and/or modify it
  44 ;;; under the terms of the GNU Lesser General Public License as
  45 ;;; published by the Free Software Foundation, either version 3 of the
  46 ;;; License, or (at your option) any later version.
  47 ;;;
  48 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  49 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  50 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  51 ;;; Public License for more details.
  52 ;;;
  53 ;;; You should have received a copy of the GNU Lesser General Public
  54 ;;; License along with this program.  If not, see
  55 ;;; <http://www.gnu.org/licenses/>.
  56 ;;;
  57 ;;; Derived from upstream OpenGL documentation.
  58 " port)
  59   (for-each
  60    (lambda (copyright)
  61      (display ";;; " port)
  62      (newline port)
  63      (for-each (lambda (line)
  64                  (display ";;; " port)
  65                  (display line port)
  66                  (newline port))
  67                (string-split
  68                 (string-trim-both (stexi->plain-text copyright))
  69                 #\newline)))
  70    (unique-copyrights defs))
  71   (display "\
  72 ;;;
  73 ;;; Automatically generated; you probably don't want to edit this.  To
  74 ;;; update, run \"make update\" in the top-level build tree.
  75 ;;;
  76 " port)
  77   (newline port)
  78   (pretty-print
  79    `(define-module ,mod-name
  80       #:use-module (figl low-level support)
  81       #:export ,(map (lambda (def)
  82                        (string->symbol (gl-definition-name def)))
  83                      defs))
  84    port)
  85   (newline port)
  86   (for-each
  87    (lambda (def)
  88      (pretty-print
  89       `(define-gl-procedure ,(string->symbol (gl-definition-name def))
  90          ,(gl-definition-name def)
  91          ,(gl-definition-prototype def)
  92          #;
  93          ,(string-trim-both
  94            (stexi->plain-text
  95             (gl-definition-documentation def)))
  96          ',(gl-definition-documentation def))
  97       port)
  98      (newline port))
  99    defs))
 100
 101 (define (write-texi mod-name defs port)
 102   (display
 103    (stexi->texi
 104     `(*fragment*
 105       (para "The functions from this section may be had by loading "
 106             "the module:")
 107       (example "(use-modules " ,(object->string mod-name) ")")
 108       (copying
 109        (para
 110         "This section of the manual was derived from the upstream "
 111         "OpenGL documentation.  Each function's documentation has "
 112         "its own copyright statement; for full details, see the "
 113         "upstream documentation.  The copyright notices and licenses "
 114         "present in this section are as follows.")
 115        ,@(append-map cdr (unique-copyrights defs)))
 116       ,@(map
 117          (lambda (def)
 118            `(defun (% (name ,(gl-definition-name def))
 119                       ;; FIXME: proper prototype.
 120                       ;; (gl-definition-prototype def)
 121                       (arguments))
 122               ,@(cdr (gl-definition-documentation def))))
 123          defs)))
 124    port))
 125
 126 (define (write-bindings mod-name defs)
 127   (call-with-output-file (module-name->scm-name mod-name)
 128     (lambda (port)
 129       (write-scm mod-name defs port)))
 130   (call-with-output-file (module-name->texi-name mod-name)
 131     (lambda (port)
 132       (write-texi mod-name defs port))))
 133
 134 (define (partition-definitions version)
 135   (fold-values
 136    (lambda (def gl glu glx)
 137      (cond
 138       ((string-prefix? "glu" (gl-definition-name def))
 139        (values gl (cons def glu) glx))
 140       ((string-prefix? "glX" (gl-definition-name def))
 141        (values gl glu (cons def glx)))
 142       (else
 143        (values (cons def gl) glu glx))))
 144    (parse-gl-definitions version)
 145    '()
 146    '()
 147    '()))
 148
 149 (define* (main arg0 #:optional (version "2"))
 150   (call-with-values
 151       (lambda () (partition-definitions version))
 152     (lambda (gl glu glx)
 153       (write-bindings '(figl low-level gl) (reverse gl))
 154       (write-bindings '(figl low-level glu) (reverse glu))
 155       (write-bindings '(figl low-level glx) (reverse glx)))))
 156
 157 (when (batch-mode?)
 158   (apply main (command-line)))