106 lines
3.7 KiB
Scheme
106 lines
3.7 KiB
Scheme
;; Defines the entity aspect of the component-entity-system
|
|
;; Entities are really, really simple, often just an ID
|
|
;; We are just going to store an ID and a list of components.
|
|
|
|
(define-module (ces entity)
|
|
#:pure
|
|
#:use-module (scheme base)
|
|
#:use-module (scheme case-lambda)
|
|
#:use-module (hoot atomics)
|
|
#:use-module (hoot hashtables)
|
|
#:use-module (hoot match)
|
|
#:export (game-entity?
|
|
game-entity-id
|
|
create-entity
|
|
|
|
get-component
|
|
get-components
|
|
|
|
has-component?
|
|
has-components?
|
|
|
|
set-component!
|
|
add-component!
|
|
update-component!
|
|
delete-component!
|
|
|
|
create-entity-generator))
|
|
|
|
(define-record-type <game-entity>
|
|
(make-game-entity id components)
|
|
game-entity?
|
|
(id game-entity-id)
|
|
(components game-entity-components entity-components-set!))
|
|
|
|
(define (create-entity id)
|
|
"Creates a new game entity"
|
|
(make-game-entity id (make-eq-hashtable)))
|
|
|
|
(define (get-component entity component-name)
|
|
"Returns the component from entity with component-name if it exists,
|
|
false otherwise."
|
|
(hashtable-ref (game-entity-components entity) component-name #f))
|
|
|
|
(define (has-component? entity component-name)
|
|
"Returns true if the entity has a component with component-name,
|
|
or false if the component is not found."
|
|
(if (get-component entity component-name)
|
|
#t #f))
|
|
|
|
(define (get-components entity name . names)
|
|
"Returns a list of components matching the provided critera
|
|
(get-components renderable-entity 'position 'sprite)
|
|
would return '(POSITION-COMPONENT SPRITE-COMPONENT)
|
|
The order is preserved. If a component with that name
|
|
does not exist, false is returned in place of the component. "
|
|
(append
|
|
(map (lambda (n)
|
|
(get-component entity n))
|
|
names)
|
|
`(,name)))
|
|
|
|
(define (has-components? entity name . names)
|
|
"Returns true if entity has every component named in names,
|
|
false otherwise."
|
|
(if (null? names)
|
|
(has-component? entity name)
|
|
(and (has-component? entity name)
|
|
(has-components? entity (cdr names)))))
|
|
|
|
(define (set-component! entity component-name component)
|
|
"Replaces the component in entity with component-name.
|
|
Add the component if one does not exist."
|
|
(let ((e-components (game-entity-components entity)))
|
|
(hashtable-set! e-components component-name component)))
|
|
|
|
(define (add-component! entity component-name component)
|
|
"Appends component to entity's component list.
|
|
Does nothing if component-name exists."
|
|
(when (not (get-component entity component-name))
|
|
(set-component! entity component-name component)))
|
|
|
|
(define (update-component! entity component-name proc)
|
|
"Swaps entity component with component-name with the result
|
|
of applying proc to the existing component. Does nothing if
|
|
the component does not exist."
|
|
(let ((old-component (get-component entity component-name)))
|
|
(when old-component
|
|
(set-component! entity component-name (proc old-component)))))
|
|
|
|
(define (delete-component! entity component-name)
|
|
"Removes the component with component-name from the entity.
|
|
Does nothing if the component does not exist."
|
|
(let ((components (game-entity-components entity)))
|
|
(when (hashtable-contains? components component-name)
|
|
(hashtable-delete! components component-name))))
|
|
|
|
(define (create-entity-generator)
|
|
"Returns a procedure which takes a list of components and creates
|
|
a new entity with the ID set. IDs are integers, and each generator
|
|
handles the ID state. ID generation is atomic, and thus should be
|
|
thread-safe."
|
|
(let ((id-counter (make-atomic-box 0)))
|
|
(lambda (components)
|
|
(let ((current-id (atomic-box-swap! id-counter
|
|
(+ 1 (atomic-box-ref id-counter)))))
|
|
(make-game-entity current-id components)))))
|