figl/glu/runtime.scm

   1 ;;; figl
   2 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
   3 ;;;
   4 ;;; Figl is free software: you can redistribute it and/or modify it
   5 ;;; under the terms of the GNU Lesser General Public License as
   6 ;;; published by the Free Software Foundation, either version 3 of the
   7 ;;; License, or (at your option) any later version.
   8 ;;;
   9 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  10 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  12 ;;; Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU Lesser General Public
  15 ;;; License along with this program.  If not, see
  16 ;;; <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19 ;;
  20 ;; figl is the Foreign Interface to GL.
  21 ;;
  22 ;;; Code:
  23
  24 (define-module (figl glu runtime)
  25   #:use-module (system foreign)
  26   #:use-module (figl runtime)
  27   #:export (define-glu-procedure define-glu-procedures))
  28
  29 (define libGLU
  30   (delay (dynamic-link "libGLU")))
  31
  32 (define (resolve name)
  33   (dynamic-pointer (symbol->string name) (force libGLU)))
  34
  35 (define-syntax define-glu-procedure
  36   (syntax-rules (->)
  37     ((define-glu-procedure (name (pname ptype) ... -> type)
  38        docstring)
  39      (define-foreign-procedure (name (pname ptype) ... -> type)
  40        (resolve 'name)
  41        docstring))))
  42
  43 (define-syntax define-glu-procedures
  44   (syntax-rules ()
  45     ((define-glu-procedures ((name prototype ...) ...)
  46        docstring)
  47      (begin
  48        (define-glu-procedure (name prototype ...)
  49          docstring)
  50        ...))))