Commit | Line | Data |
---|---|---|
25072f02 AW |
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) | |
d24cc2b8 AW |
28 | #:export (*resolve-hook* |
29 | define-glut-procedure)) | |
25072f02 AW |
30 | |
31 | (define libglut | |
32 | (delay (dynamic-link "libglut"))) | |
33 | ||
34 | (define (get-libglut) | |
35 | (force libglut)) | |
36 | ||
37 | (current-gl-get-dynamic-object get-libglut) | |
38 | ||
d24cc2b8 AW |
39 | (define *resolve-hook* (make-hook 1)) |
40 | ||
25072f02 | 41 | (define (resolve name) |
d24cc2b8 AW |
42 | (let ((name-str (symbol->string name))) |
43 | (run-hook *resolve-hook* name-str) | |
44 | (dynamic-pointer name-str (get-libglut)))) | |
25072f02 AW |
45 | |
46 | (define-syntax define-glut-procedure | |
47 | (syntax-rules (->) | |
48 | ((define-glut-procedure (name (pname ptype) ... -> type) | |
49 | docstring) | |
50 | (define-foreign-procedure (name (pname ptype) ... -> type) | |
51 | (resolve 'name) | |
52 | docstring)))) |