Systems, bug fixes, and first samples

This commit is contained in:
BirDt_ 2026-04-12 21:36:50 +08:00
parent df700e757b
commit d9f8f6f0d2
3 changed files with 96 additions and 21 deletions

View file

@ -22,6 +22,8 @@
;; The component-sets hash table
(define component-sets (make-hash-table))
(define component-eq-comparator (make-eq-comparator))
;; Insert an entity into component-sets, either creating
;; a new set or updating an existing one for the component
;; type provided.
@ -36,7 +38,7 @@
id)))
(hash-table-set! component-sets
component-type
(set (make-eq-comparator) id)))))
(set component-eq-comparator id)))))
;; Create an entity in the world immediately,
;; and add it to the requisite component-sets
@ -111,6 +113,12 @@
(assert (symbol? id))
(hash-table-ref world id))
;; Get all entities by their component types
(define (query-by-components . components)
(assert (every symbol? components))
(let ((sets (map (lambda (comp) (hash-table-ref component-sets comp)) components)))
(apply set-intersection sets)))
;; Create an entity in the world and return it's ID
;; TODO: consider whether we want to use a hash-table for the entity list. I'm not sure yet how punishing O(n) lookup will be here, so it might be sometihng to look at once we start handling entity execution
(define (create-named-entity id . components)
@ -154,7 +162,7 @@
(define (make-system name priority mode criteria process)
(assert (symbol? name))
(assert (integer? priority))
(assert (member mode '(enity batch)))
(assert (member mode '(entity batch)))
(assert (every symbol? criteria))
(assert (procedure? process))
(int:make-system name priority mode criteria process))
@ -236,7 +244,7 @@
(sort-systems))
;; System creation/removal interface
(export add-system remove-system clear-systems)
(export add-system remove-system clear-systems execute-system execute-systems)
;; Add a system to the state processing and return its name
(define (add-system system)
@ -256,10 +264,12 @@
(map system-name systems)))
;; Execute a single system
;; TODO: Implement
(define (execute-system system)
(assert (system? system))
#t)
(let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
(cond
((eqv? (system-mode system) 'batch) ((system-process system) entities))
((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities)))))
(define (execute-systems)
(for-each
@ -386,7 +396,7 @@
(when (eq? mode '3d)
(begin-mode-3d (*active-camera-3d*)))
(for-each
(lambda (render-obj) (cdr render-obj))
(lambda (render-obj) ((cdr render-obj)))
(sort queue
(lambda (render-obj-a render-obj-b)
(< (car render-obj-a)
@ -422,10 +432,11 @@
;; Generate the next frame, for use in the main game loop
(define (next-frame)
(resolve-queues)
(execute-systems)
(perform-render))
;; Window creation
(export *window-size* *window-title* create-window)
(export *window-size* *window-title* *target-fps* create-window)
;; Window size to use
(define *window-size* (guarded-parameter '(768 . 576)