103 lines
2.7 KiB
Scheme
103 lines
2.7 KiB
Scheme
(module (engine core) *
|
|
(import scheme
|
|
(chicken base)
|
|
raylib
|
|
(srfi 69)
|
|
(srfi 99)
|
|
(srfi 113)
|
|
(srfi 128))
|
|
|
|
;; The world hash table
|
|
(define world (make-hash-table))
|
|
;; The component-sets hash table
|
|
(define component-sets (make-hash-table))
|
|
|
|
;; Insert an entity into component-sets, either creating
|
|
;; a new set or updating an existing one for the component
|
|
;; type provided.
|
|
(define (classify-entity-by id component)
|
|
(let ((component-type (rtd-name (record-rtd component))))
|
|
(if (hash-table-exists? component-sets component-type)
|
|
(let ((component-set (hash-table-ref component-sets component-type)))
|
|
(hash-table-set! component-sets
|
|
component-type
|
|
(set-adjoin component-set
|
|
id)))
|
|
(hash-table-set! component-sets
|
|
component-type
|
|
(set (make-eq-comparator) id)))))
|
|
|
|
;; Create an entity in the world immediately,
|
|
;; and add it to the requisite component-sets
|
|
(define (create-entity id components)
|
|
(hash-table-set! world id components)
|
|
(for-each
|
|
(lambda (component)
|
|
(classify-entity-by id component))
|
|
components))
|
|
|
|
;; Remove a single matching item from a set
|
|
(define (set-remove! set element)
|
|
(set-search! set element
|
|
(lambda (insert ignore)
|
|
(ignore #f))
|
|
(lambda (old update remove)
|
|
(remove old))))
|
|
|
|
;; Remove an entity from the world immediately,
|
|
;; as well as from all component sets.
|
|
(define (remove-entity id)
|
|
(hash-table-delete! world id)
|
|
(for-each
|
|
(lambda (set)
|
|
(set-remove! set id))
|
|
(hash-table-values component-sets)))
|
|
|
|
;; Queues for entity creation and deletion
|
|
(define add-entity-queue '())
|
|
(define del-entity-queue '())
|
|
|
|
;; Add an entity to the incoming queue
|
|
;; TODO: append! doesn't work here and IDK why
|
|
(define (queue-add-entity id components-lst)
|
|
(set! add-entity-queue
|
|
(append add-entity-queue (list (cons id components-lst)))))
|
|
|
|
;; Add an entity to the deletion queue
|
|
(define (queue-del-entity id)
|
|
(set! del-entity-queue
|
|
(append del-entity-queue (list id))))
|
|
|
|
;; Resolve all new entity creations
|
|
(define (add-queued-entities)
|
|
(for-each
|
|
(lambda (entity)
|
|
(let ((id (car entity))
|
|
(components (cdr entity)))
|
|
(create-entity id components)))
|
|
add-entity-queue)
|
|
(set! add-entity-queue '()))
|
|
|
|
;; Resolve all queued entity deletions
|
|
(define (remove-queued-entities)
|
|
(for-each
|
|
(lambda (id)
|
|
(remove-entity id))
|
|
del-entity-queue)
|
|
(set! del-entity-queue '()))
|
|
|
|
;; Create an instance of an entity in the world and return it's ID
|
|
(define (add-instance-named id . components)
|
|
(queue-add-entity id components)
|
|
id)
|
|
|
|
;; Shortcut for anonymous instancing
|
|
(define (add-instance . components)
|
|
(apply add-instance-named (gensym) components))
|
|
|
|
;; Remove an instance from the world
|
|
(define (remove-instance id)
|
|
(queue-del-entity id)
|
|
id)
|
|
|
|
)
|