From f3d35ed115ff03f513c93a05325885e44da10891 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Thu, 23 Jun 2016 02:03:28 +0200 Subject: [PATCH] Trash --- src/entity.scm | 36 +++++++++++++++ src/gacela.scm | 6 ++- src/system.scm | 106 +++++++++++++++------------------------------ src/utils.scm | 33 ++++++++++++++ tests/entities.scm | 33 +++++++++----- 5 files changed, 132 insertions(+), 82 deletions(-) create mode 100644 src/entity.scm create mode 100644 src/utils.scm diff --git a/src/entity.scm b/src/entity.scm new file mode 100644 index 0000000..9f435dd --- /dev/null +++ b/src/entity.scm @@ -0,0 +1,36 @@ +;;; 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 entity) + #:use-module (bongodb) + #:export (make-entity-set + add-entities + entities-count)) + +(define (make-entity-set . entities) + (add-entities (make-collection) entities)) + +(define (add-entities entity-set . entities) + (let ((entities (filter + (lambda (e) (not (null? e))) + entities))) + (cond (entities + (apply insert (cons entity-set entities))) + (else + entity-set)))) + +(define (entities-count entity-set) + (count entity-set)) diff --git a/src/gacela.scm b/src/gacela.scm index 7fb242f..3b65aff 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -18,11 +18,15 @@ (define-module (gacela gacela) #:use-module (gacela system) #:use-module (ice-9 threads) - #:use-module (srfi srfi-1)) + #:use-module (srfi srfi-1) + #:export (make-world)) ;;; Entities and components +(define (make-world . entities) + (apply make-entity-set entities)) + (define entities-mutex (make-mutex)) (define game-entities '()) (define game-components '()) diff --git a/src/system.scm b/src/system.scm index 1df24f9..50e9534 100644 --- a/src/system.scm +++ b/src/system.scm @@ -16,10 +16,34 @@ (define-module (gacela system) + #:use-module ((bongodb) #:renamer (symbol-prefix-proc 'bongodb:)) #:use-module (ice-9 receive) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:use-module (srfi srfi-9 gnu)) + #:use-module (srfi srfi-9 gnu) + #:export (define-component + export-component + get-component-type + make-entity-set + entity-list + entity-count + new-entity + get-entity + remove-entity + set-entity + set-entity-components + remove-entity-components + modify-entities + entities-changes + entities-changes? + get-entities-changes + find-entities-by-components + define-system + make-system + join-systems + thread-systems + get-key + get-component)) ;;; Component definitions @@ -85,23 +109,17 @@ (define (get-component-type component) (record-type-name (record-type-descriptor component))) -(export define-component - export-component - get-component-type) - ;;; Entities and components (define (make-entity-set . changes) - (modify-entities - (cons (make-hash-table) (make-hash-table)) - changes)) + (modify-entities (bongodb:make-collection) changes)) (define (entity-list entity-set) - (hash-map->list (lambda (k v) (cons k v)) (car entity-set))) + (bongodb:find entity-set)) (define (entity-count entity-set) - (hash-count (const #t) (car entity-set))) + (bongodb:count entity-set)) (define (normalize-components components) (map @@ -111,48 +129,16 @@ c)) components)) -(define (register-components entity components clist) - (cond ((null? components) clist) - (else - (let* ((type (car components)) - (elist (hash-ref clist type))) - (hash-set! clist type - (cond (elist - (lset-adjoin eq? elist entity)) - (else - (list entity)))) - (register-components entity (cdr components) clist))))) - -(define (unregister-components entity components clist) - (cond ((null? components) clist) - (else - (let* ((type (car components)) - (elist (lset-difference eq? (hash-ref clist type) (list entity)))) - (cond ((null? elist) - (hash-remove! clist type)) - (else - (hash-set! clist type elist))) - (unregister-components entity (cdr components) clist))))) - -(define (component-names components) - (map (lambda (c) (car c)) components)) - -(define (entity-component-names key entity-set) - (component-names - (hash-ref (car entity-set) key))) - (define (entity-ref key entity-set) (hash-get-handle (car entity-set) key)) -(define (new-entity . new-components) - (lambda (entity-set) - (let ((key (gensym)) - (nc (normalize-components new-components))) - (hash-set! (car entity-set) key nc) - (register-components key (component-names nc) (cdr entity-set)) - (values - entity-set - (cons key nc))))) +(define (new-entity entity-set . new-components) + (receive (new-set new-keys) (bongodb:insert entity-set (normalize-components new-components)) + (values new-set (car new-keys)))) + +(define (get-entity entity-set key) + (let ((entity (bongodb:find entity-set (bongodb:$eq '_id key)))) + (and entity (car entity)))) (define (remove-entity key) (lambda (entity-set) @@ -210,16 +196,6 @@ (else (modify-entities ((car changes) entity-set) (cdr changes))))) -(export make-entity-set - entity-list - entity-count - new-entity - remove-entity - set-entity - set-entity-components - remove-entity-components - modify-entities) - ;;; Making systems @@ -294,15 +270,6 @@ (else (run-wait (cdr thd) (cons (join-thread (car thd)) res))))))) -(export entities-changes - entities-changes? - get-entities-changes - find-entities-by-components - define-system - make-system - join-systems - thread-systems) - ;;; Entities and components access inside systems @@ -311,6 +278,3 @@ (define (get-component component-name entity) (assoc-ref (cdr entity) component-name)) - -(export get-key - get-component) diff --git a/src/utils.scm b/src/utils.scm new file mode 100644 index 0000000..5f56f05 --- /dev/null +++ b/src/utils.scm @@ -0,0 +1,33 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2016 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 utils) + #:export (make-producer)) + +(define (make-producer body) + (define resume #f) + (lambda (real-send) + (define send-to real-send) + (define (send value-to-send) + (set! send-to + (call/cc + (lambda (k) + (set! resume k) + (send-to value-to-send))))) + (if resume + (resume real-send) + (body send)))) diff --git a/tests/entities.scm b/tests/entities.scm index c0a9a51..2fd532a 100644 --- a/tests/entities.scm +++ b/tests/entities.scm @@ -1,5 +1,5 @@ ;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2013 by Javier Sancho Fernandez +;;; Copyright (C) 2016 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 @@ -14,20 +14,33 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . -(use-modules (gacela system) +(use-modules (gacela entity) + (ice-9 receive) (srfi srfi-64)) (test-begin "entities") -(define-component a x y) -(define-component b) - -(define entities (make-entity-set)) +(define entity-set (make-entity-set)) +(define key #f) ; Creating entities -(set! entities ((new-entity (make-a 1 2) (make-b)) entities)) -(set! entities ((new-entity (make-a 10 20)) entities)) -((new-entity (make-a 10 20)) entities) -(test-eqv 2 (length (entity-list entities))) + +(receive (e k) (add-entities entity-set '((a . (1 2)) (b . #f))) + (set! entity-set e) + (set! key (car k))) +(set! entity-set (add-entities entity-set '((a . (10 20))))) +(add-entities entity-set '((a . (10 20)))) +(test-eqv 2 (entities-count entity-set)) + +;; (define-component a x y) +;; (define-component b) + +;; (define entities (make-entity-set)) +;; (define key #f) + +;; ; Modifying entities +;; (define component (assoc-ref (get-entity entities key) 'a)) +;; (test-eqv 1 (a-x component)) +;; (test-eqv 2 (a-y component)) (test-end "entities") -- 2.39.5