1 ;;; Gacela, a GNU Guile extension for fast games development
2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;;; GNU General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
18 (define-module (gacela views)
19 #:use-module (gacela gacela)
20 #:use-module ((gacela video) #:renamer (symbol-prefix-proc 'video:))
21 #:use-module ((gacela gl) #:select (glPushMatrix glPopMatrix))
22 #:use-module (ice-9 optargs))
24 (define-macro (define-view name content)
26 (hash-set! active-views ',name (lambda () (video:glmatrix-block ,content)))
29 (define (mesh primitive)
30 (let ((x 0) (y 0) (z 0)
33 (lambda (option . params)
37 (video:rotate rx ry rz)
38 (video:translate x y z)
39 (video:rotate ax ay az)
42 `((x . ,x) (y . ,y) (z . ,z) (ax . ,ax) (ay . ,ay) (az . ,az) (rx . ,rx) (ry . ,ry) (rz . ,rz)))))))
44 (define-macro (define-mob mob-head . body)
45 (let* ((name (car mob-head))
47 (make-fun-symbol (gensym))
48 (mob-fun-symbol (gensym))
49 (params-symbol (gensym)))
50 `(define (,name . ,params-symbol)
51 (define ,make-fun-symbol
52 (lambda* ,(if (null? attr) '() `(#:key ,@attr))
53 (the-mob ,name (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr)))))
54 (define ,mob-fun-symbol
55 (define-mob-function ,attr ,@body))
56 (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
57 (apply ,make-fun-symbol ,params-symbol))
59 (apply ,mob-fun-symbol ,params-symbol))))))
62 (define-macro (define-mesh name . mesh)
63 (let* ((make-fun-symbol (gensym))
64 (mesh-fun-symbol (gensym))
65 (params-symbol (gensym)))
67 (let ((,make-fun-symbol
71 (lambda (. ,params-symbol)
72 (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
73 (apply ,make-fun-symbol ,params-symbol))
75 (apply ,mesh-fun-symbol ,params-symbol))))))))
78 (define-macro (define-primitives . symbols)
79 (cond ((null? symbols)
83 (define (,(caar symbols) . params) (mesh (lambda () (apply ,(cadar symbols) params))))
84 (define-primitives ,@(cdr symbols))))))
86 ; (define-macro (,(caar symbols) . params) (let ((f ',(cadar symbols))) `(mesh (lambda () (apply ,f ',params)))))
89 (rectangle video:draw-rectangle)
90 (square video:draw-square))
93 (module-map (lambda (sym var)
94 (if (not (eq? sym '%module-public-interface))
95 (module-export! (current-module) (list sym))))