From: Javier Sancho Date: Mon, 9 Sep 2013 04:54:07 +0000 (+0200) Subject: Better examples X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=2b3814bf3f335a56c17b733caf90c17dbe229e91;p=gacela.git Better examples --- diff --git a/src/examples/composing-systems.scm b/src/examples/composing-systems.scm new file mode 100644 index 0000000..feecee3 --- /dev/null +++ b/src/examples/composing-systems.scm @@ -0,0 +1,74 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2013 by Javier Sancho Fernandez +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + + +(define-module (gacela examples composing-systems) + #:use-module (gacela system) + #:use-module (ice-9 receive)) + + +(define s1 + (make-system '(l) + (lambda (e) + (sleep 3) + (map + (lambda (e1) + (set-entity-components (car e1) `(l . ,(cons 1 (cdadr e1))))) + e)))) + +(define s2 + (make-system '(l) + (lambda (e) + (sleep 4) + (map + (lambda (e1) + (set-entity-components (car e1) `(l . ,(cons 2 (cdadr e1))))) + e)))) + +(define (composing-with-join) + (let ((entities '()) + (components '())) + (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) + ((join-systems s1 s2) e c)))) + +(export composing-with-join) + + +(define (composing-with-threaded) + (let ((entities '()) + (components '())) + (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) + ((threaded-systems s1 s2) e c)))) + +(export composing-with-threaded) + + +(define (join-vs-threaded) + (let ((entities '()) + (components '()) + (t (current-time))) + (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) + (receive (e c) ((join-systems s1 s2) e c) + (format #t "~a~%~a~%Time: ~a~%~%" e c (- (current-time) t))))) + + (let ((entities '()) + (components '()) + (t (current-time))) + (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) + (receive (e c) ((threaded-systems s1 s2) e c) + (format #t "~a~%~a~%Time: ~a~%~%" e c (- (current-time) t)))))) + +(export join-vs-threaded) diff --git a/src/examples/entity-component-functions.scm b/src/examples/entity-component-functions.scm new file mode 100644 index 0000000..43316fc --- /dev/null +++ b/src/examples/entity-component-functions.scm @@ -0,0 +1,70 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2013 by Javier Sancho Fernandez +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + + +(define-module (gacela examples entity-component-functions) + #:use-module (gacela system) + #:use-module (ice-9 receive)) + + +(define-component a x y) +(define-component b) + +(define (entity-component-functions) + (let ((entities '()) + (components '()) + (key #f)) + (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) + (set! entities e) + (set! components c) + (set! key k) + (display k) (newline)) + (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) + + (receive (e c k) ((new-entity (make-a 10 20)) entities components) + (set! entities e) + (set! components c) + (display k) (newline)) + (format #t "New entity with a:~%~a~%~a~%~%" entities components) + + (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b)) entities components) + (set! entities e) + (set! components c)) + (format #t "First entity removes b and changes a:~%~a~%~a~%~%" entities components) + + (receive (e c) ((remove-entity key) entities components) + (set! entities e) + (set! components c)) + (format #t "Removes first entity:~%~a~%~a~%~%" entities components) + + (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) + (set! entities e) + (set! components c) + (set! key k) + (display k) (newline)) + (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) + + (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b) (new-entity (make-a 1000 1000))) entities components) + (set! entities e) + (set! components c)) + (format #t "Last entity removes b and changes a, and new entity with a:~%~a~%~a~%~%" entities components) + + (receive (e c) (modify-entities (list (remove-entity key)) entities components) + (set! entities e) + (set! components c)) + (format #t "Remove last entity:~%~a~%~a~%~%" entities components))) + +(export entity-component-functions) diff --git a/src/examples/making-systems.scm b/src/examples/making-systems.scm new file mode 100644 index 0000000..b3f381d --- /dev/null +++ b/src/examples/making-systems.scm @@ -0,0 +1,35 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2013 by Javier Sancho Fernandez +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + + +(define-module (gacela examples making-systems) + #:use-module (gacela system) + #:use-module (ice-9 receive)) + + +(define-component a x y) + +(define (making-systems) + (let ((entities '()) + (components '())) + (receive (e c) (((make-system '() (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components)) + (set! entities e) + (set! components c)) + (format #t "Two new entities with a:~%~a~%~a~%~%" entities components) + + (((make-system '(a) (lambda (e) (display e) (newline) '())) entities components)))) + +(export making-systems) diff --git a/src/test.scm b/src/test.scm deleted file mode 100644 index 353987b..0000000 --- a/src/test.scm +++ /dev/null @@ -1,122 +0,0 @@ -;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2013 by Javier Sancho Fernandez -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see . - - -(define-module (gacela test) - #:use-module (gacela system) - #:use-module (ice-9 receive)) - - -(define-component a x y) -(define-component b) -(define-component c) - -(export-component a) - -(define (test1) - (let ((entities '()) - (components '()) - (key #f)) - (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) - (set! entities e) - (set! components c) - (set! key k) - (display k) (newline)) - (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) - - (receive (e c k) ((new-entity (make-a 10 20)) entities components) - (set! entities e) - (set! components c) - (display k) (newline)) - (format #t "New entity with a:~%~a~%~a~%~%" entities components) - - (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b)) entities components) - (set! entities e) - (set! components c)) - (format #t "First entity removes b and changes a:~%~a~%~a~%~%" entities components) - - (receive (e c) ((remove-entity key) entities components) - (set! entities e) - (set! components c)) - (format #t "Removes first entity:~%~a~%~a~%~%" entities components) - - (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) - (set! entities e) - (set! components c) - (set! key k) - (display k) (newline)) - (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) - - (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b) (new-entity (make-a 1000 1000))) entities components) - (set! entities e) - (set! components c)) - (format #t "Last entity removes b and changes a, and new entity with a:~%~a~%~a~%~%" entities components) - - (receive (e c) (modify-entities (list (remove-entity key)) entities components) - (set! entities e) - (set! components c)) - (format #t "Remove last entity:~%~a~%~a~%~%" entities components) -)) - -(export test1) - - -(define (test2) - (let ((entities '()) - (components '())) - (receive (e c) (((make-system '() (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components)) - (set! entities e) - (set! components c)) - (format #t "Two new entities with a:~%~a~%~a~%~%" entities components) - - (((make-system '(a) (lambda (e) (display e) (newline) '())) entities components)) -)) - -(export test2) - - -(define (test3) - (let ((entities '()) - (components '()) - (s1 (make-system '(l) - (lambda (e) - (map - (lambda (e1) - `(,(car e1) . ((l . (cons 1 (cdr e1))))) - e))))) - (s2 (make-system '(l) - (lambda (e) - (map - (lambda (e1) - `(,(car e1) . ((l . (cons 2 (cdr e1)))))) - e))))) - (receive (e c) (set-entities `((#f . ((l . ()))) (#f . ((l . ())))) entities components) - ((join-systems s1 s2) e c)))) - -(export test3) - - -(define (test4) - (let ((f1 (lambda (e c) (sleep 3) (lambda (e2 c2) (values (+ 1 e2) c2)))) - (f2 (lambda (e c) (sleep 4) (lambda (e2 c2) (values e2 (+ 10 c2)))))) - (let ((t (current-time))) - (receive (e c) ((join-systems f1 f2) 2 2) (format #t "~a~%~a~%" e c)) - (display (- (current-time) t)) (newline) (newline)) - (let ((t (current-time))) - (receive (e c) ((threaded-systems f1 f2) 2 2) (format #t "~a~%~a~%" e c)) - (display (- (current-time) t)) (newline) (newline)))) - -(export test4)