85 lines
2.9 KiB
Scheme
85 lines
2.9 KiB
Scheme
(module (test engine) ()
|
|
(import scheme
|
|
(chicken base)
|
|
(engine core)
|
|
(srfi 69)
|
|
(srfi 78)
|
|
(srfi 99))
|
|
|
|
(define-record-type <point> (make-point x y) point? (x point-x) (y point-y))
|
|
|
|
;; Entity addition and world state modification
|
|
(check (hash-table-size world) => 0) ;; World state starts empty
|
|
(check (hash-table-size component-sets) => 0)
|
|
|
|
(create-named-entity 'ball (make-point 1 1))
|
|
(check (hash-table-size world) => 0) ;; World state empty before next frame
|
|
(check (hash-table-size component-sets) => 0)
|
|
|
|
(resolve-queues) ;; TODO: swap this for (next-frame) and remove (resolve-queues) once we have a full game loop setup
|
|
(check (hash-table-size world) => 1) ;; World state updates after next frame
|
|
(check (hash-table-size component-sets) => 1)
|
|
(check (hash-table-exists? world 'ball) => #t)
|
|
(check (hash-table-exists? component-sets '<point>) => #t)
|
|
|
|
(clear-world)
|
|
(check (hash-table-size world) => 1) ;; World state does not immediately clear
|
|
|
|
(resolve-queues)
|
|
(check (hash-table-size world) => 0) ;; World state is empty after clear
|
|
(check (hash-table-size component-sets) => 1) ;; Component-sets doesn't clear
|
|
|
|
(create-named-entity 'ball (make-point 1 1))
|
|
(resolve-queues)
|
|
(remove-entity 'ball)
|
|
(resolve-queues)
|
|
(check (hash-table-size world) => 0) ;; Entity is properly removed
|
|
|
|
;; System addition and state modification
|
|
(check (length systems) => 0) ;; Systems list starts empty
|
|
|
|
(define sys-1 (make-system 'foo '3d 0 '() void))
|
|
(define sys-2 (make-system 'bar '2d 1 '() void))
|
|
(add-system sys-1)
|
|
(check (length systems) => 0) ;; Systems list is not immediately updated
|
|
|
|
(resolve-queues)
|
|
(check (length systems) => 1) ;; Systems list updates
|
|
|
|
(add-system sys-2)
|
|
(resolve-queues)
|
|
(check (length systems) => 2) ;; Systems list updates
|
|
(check (system-name (car systems)) => 'foo) ;; Foo is sorted before bar
|
|
|
|
(set-system-priority! sys-1 2)
|
|
(resolve-queues)
|
|
(check (system-name (car systems)) => 'bar) ;; Bar is sorted earlier after a priority change
|
|
|
|
(remove-system 'foo)
|
|
(check (length systems) => 2) ;; Systems list does not automatically update
|
|
|
|
(resolve-queues)
|
|
(check (length systems) => 1) ;; Systems list updates after resolution
|
|
|
|
(clear-systems)
|
|
(resolve-queues)
|
|
(check (length systems) => 0) ;; Systems list clears
|
|
|
|
;; Event bus creation and events
|
|
(check (hash-table-size event-buses) => 1) ;; Input bus already exists
|
|
|
|
(remove-event-bus 'input)
|
|
(check (hash-table-size event-buses) => 0) ;; Input bus is removed
|
|
|
|
(register-event-bus 'foo)
|
|
(check (hash-table-size event-buses) => 1) ;; Event bus registered
|
|
|
|
(push-event 'foo 'bar (make-point 1 1))
|
|
(check (hash-table-size (fetch-event-bus 'foo)) => 1) ;; Event is created
|
|
|
|
(check (point-x (peek-event 'foo 'bar)) => 1) ;; Event is peaked
|
|
(check (hash-table-size (fetch-event-bus 'foo)) => 1) ;; Event still exists
|
|
|
|
(check (point-x (pop-event 'foo 'bar)) => 1) ;; Event is popped
|
|
(check (hash-table-size (fetch-event-bus 'foo)) => 0) ;; Event is removed exists
|
|
)
|