figl/glut/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 glut runtime)
  25   #:use-module (system foreign)
  26   #:use-module (figl runtime)
  27   #:use-module (figl gl runtime)
  28   #:export (define-glut-procedure define-glut-procedures))
  29
  30 (define libglut
  31   (delay (dynamic-link "libglut")))
  32
  33 (define (get-libglut)
  34   (force libglut))
  35
  36 (current-gl-get-dynamic-object get-libglut)
  37
  38 (define (resolve name)
  39   (dynamic-pointer (symbol->string name) (get-libglut)))
  40
  41 (define-syntax define-glut-procedure
  42   (syntax-rules (->)
  43     ((define-glut-procedure (name (pname ptype) ... -> type)
  44        docstring)
  45      (define-foreign-procedure (name (pname ptype) ... -> type)
  46        (resolve 'name)
  47        docstring))))
  48
  49 (define-syntax define-glut-procedures
  50   (syntax-rules ()
  51     ((define-glut-procedures ((name prototype ...) ...)
  52        docstring)
  53      (begin
  54        (define-glut-procedure (name prototype ...)
  55          docstring)
  56        ...))))