]> git.jsancho.org Git - gacela.git/blob - src/examples/composing-systems.scm
1d775c1a9717b4e1e111badd89c7d2eb7d7a53d1
[gacela.git] / src / examples / composing-systems.scm
1 ;;; Gacela, a GNU Guile extension for fast games development
2 ;;; Copyright (C) 2013 by Javier Sancho Fernandez <jsf at jsancho dot org>
3 ;;;
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.
8 ;;;
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.
13 ;;;
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/>.
16
17
18 (define-module (gacela examples composing-systems)
19   #:use-module (gacela system)
20   #:use-module (ice-9 receive))
21
22
23 (define-system s1 ((with-l (l)))
24   (sleep 3)
25   (entities-changes
26    (map (lambda (e)
27           (set-entity-components (get-key e) '(l1 . 1)))
28         with-l)))
29
30 (define-system s2 ((with-l (l)))
31   (sleep 4)
32   (entities-changes
33    (map (lambda (e)
34           (set-entity-components (get-key e) '(l2 . 2)))
35         with-l)))
36
37 (define (composing-with-join)
38   (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f)))))
39     (set! entities (modify-entities entities (get-entities-changes ((join-systems s1 s2) entities))))
40     (entity-list entities)))
41
42 (export composing-with-join)
43
44
45 (define (composing-with-thread)
46   (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f)))))
47     (set! entities (modify-entities entities (get-entities-changes ((thread-systems s1 s2) entities))))
48     (entity-list entities)))
49   
50 (export composing-with-thread)
51
52
53 (define (join-vs-thread)
54   (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f))))
55         (t (current-time)))
56     (set! entities (modify-entities entities (get-entities-changes ((join-systems s1 s2) entities))))
57     (format #t "~a~%Time: ~a~%~%" entities (- (current-time) t)))
58
59   (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f))))
60         (t (current-time)))
61     (set! entities (modify-entities entities (get-entities-changes ((thread-systems s1 s2) entities))))
62     (format #t "~a~%Time: ~a~%~%" entities (- (current-time) t))))
63
64 (export join-vs-thread)