System definition facilities

wh-engine.asd

@@ -11,11 +11,13 @@
   ((:module "wh-engine"
     :components ((:file "package")
                  (:file "global")
-                 (:file "serialization")
                  (:file "actor")
                  (:file "component")
                  (:file "actor-macros")
                  (:file "scene")
+                 (:file "serialization")
+                 (:file "systems")
+                 (:file "render/render-system")
                  (:file "render/drawable")
                  (:file "render/view")
                  (:file "main"))

wh-engine/global.lisp

@@ -53,16 +53,6 @@
   (declare (type vec3 vector))
   (vec2 (ftruncate (vx3 vector)) (ftruncate (vy3 vector))))
 
-(defun opengl-matrix (matrix)
-  (declare (type mat3 matrix))
-  (with-fast-matref (m matrix 3)
-    (make-array '(16) :initial-contents
-                `(,(m 0 0) ,(m 0 1) 0.0 ,(m 0 2)
-                  ,(m 1 0) ,(m 1 1) 0.0 ,(m 1 2)
-                      0.0      0.0  1.0     0.0
-                  ,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
-                )))
-
 (defvar *id-counter* 0
   "Counter for assigning unique IDs.")
 
@@ -149,9 +139,9 @@
   `(when (typep ,place 'id-ref)
      (setf ,place (pointerize ,place))))
 
-(defvar *world-scenes* ()
+(defvar *world* ()
   "List of all running scenes.")
 
 (defun get-scene (scene-id)
   "Get a scene by its ID."
-  (find-if (lambda (scene) (eql (o! scene id) scene-id)) *world-scenes*))
+  (find-if (lambda (scene) (eql (o! scene id) scene-id)) *world*))

wh-engine/main.lisp

@@ -1,20 +1,6 @@
 ;;;; wh-engine/main.lisp
 (in-package wh-engine)
 
-(defun add-scene (scene)
-  "Add a scene to the list of running scenes."
-  (declare (type scene scene))
-
-  (push scene *world-scenes*)
-  scene)
-
-(defun remove-scene (scene)
-  "Remove a scene from the list of running scenes."
-  (declare (type scene scene))
-
-  (setf *world-scenes* (remove scene *world-scenes*))
-  scene)
-
 (defun initialize-actors-in (scene &rest actors)
   "Properly attach actors and their descendents to scene, and initialize them."
   (loop for actor in actors
@@ -29,21 +15,6 @@
              (o! actor (activate)))
         ))
 
-(defvar *view-width* 384
-  "View-space width in pixels.")
-(defvar *view-height* 256
-  "View-space height in pixels.")
-(defvar *view-ppu* 64
-  "Pixels in view-space per unit in world-space.")
-
-(defvar *pixel-scale* 2
-  "Scaling factor for rendered pixels.")
-
-(defvar *world-drawables* nil
-  "List of all known drawables.")
-(defvar *world-views* nil
-  "List of all known views.")
-
 (defvar *delta-time* 0.0
   "Time in seconds since the last game tick.")
 
@@ -53,143 +24,155 @@
     (initialize-actors-in test-scene
                           (new! actor
                                 :name "Actor"
-                                :component (new! drawable-test))
+                                :component (new! whe/render:drawable-test))
                           (new! actor
                                 :name "Actor 2"
                                 :location (vec2 0.5 0.5)
                                 :rotation (coerce (/ pi 4) 'single-float)
                                 :z-layer -1
-                                :component (new! drawable-test :colour (vec4 0 1 0 1))
+                                :component (new! whe/render:drawable-test :colour (vec4 0 1 0 1))
                                 :child (new! actor
                                              :name "Child Actor"
                                              :location (vec2 0 0.5)
                                              :z-layer -2
-                                             :component (new! drawable-test :colour (vec4 0 1 1 1))
+                                             :component (new! whe/render:drawable-test :colour (vec4 0 1 1 1))
                                              :child (new! actor
                                                           :name "Grandchild Actor"
                                                           :location (vec2 0 1)
                                                           :scale (vec2 0.25 0.25)
                                                           :z-layer 1
-                                                          :component (new! drawable-test :colour (vec4 1 1 0 1)))))
+                                                          :component (new! whe/render:drawable-test :colour (vec4 1 1 0 1)))))
                           (new! actor
                                 :name "Camera"
-                                :component (new! view)))
+                                :component (new! whe/render:view)))
     test-scene))
 
-(defun run ()
+(defmacro run ()
   "Run the main game loop."
-  (sdl2:with-init (:everything)
+  `(sdl2:with-init (:everything)
-    (format t "wh-engine: using SDL ~D.~D.~D~%"
+     (format t "wh-engine: using SDL ~D.~D.~D~%"
-            sdl2-ffi:+sdl-major-version+
+             sdl2-ffi:+sdl-major-version+
-            sdl2-ffi:+sdl-minor-version+
+             sdl2-ffi:+sdl-minor-version+
-            sdl2-ffi:+sdl-patchlevel+)
+             sdl2-ffi:+sdl-patchlevel+)
-    (finish-output)
+     (finish-output)
-    (sdl2:with-window (win :flags '(:shown :opengl)
+     (sdl2:with-window (win :flags '(:shown :opengl)
-                           :w (* *view-width* *pixel-scale*) :h (* *view-height* *pixel-scale*)
+                            :w (* whe/render:*view-width* whe/render:*pixel-scale*) :h (* whe/render:*view-height* whe/render:*pixel-scale*)
-                           :title (format nil "wh-engine ~1{~D.~D.~D~} (Affero GPL; NON-FREE USAGE PROHIBITED)"
+                            :title (format nil "wh-engine ~1{~D.~D.~D~} (Affero GPL; NON-FREE USAGE PROHIBITED)"
-                                          +version+))
+                                           +version+))
-      (sdl2:with-gl-context (gl-context win)
+       (sdl2:with-gl-context (gl-context win)
-        (sdl2:gl-make-current win gl-context)
+         (sdl2:gl-make-current win gl-context)
-        (let ((framebuf (gl:gen-framebuffer))
+         (let (#|(framebuf (gl:gen-framebuffer))
-              (renderbuf (gl:gen-renderbuffer))
+               (renderbuf (gl:gen-renderbuffer))
-              (render-texture (gl:gen-texture))
+               (render-texture (gl:gen-texture))
-              (win-width (nth-value 0 (sdl2:get-window-size win)))
+               (win-width (nth-value 0 (sdl2:get-window-size win)))
-              (win-height (nth-value 1 (sdl2:get-window-size win)))
+               (win-height (nth-value 1 (sdl2:get-window-size win)))|#
-              (prev-tick (sdl2:get-ticks))
+               (prev-tick (sdl2:get-ticks))
-              (this-tick (sdl2:get-ticks))
+               (this-tick (sdl2:get-ticks))
-              (prev-profiling-tick (sdl2:get-performance-counter))
+               (prev-profiling-tick (sdl2:get-performance-counter))
-              (profiling-scale (/ (sdl2:get-performance-frequency) 1000.0)))
+               (profiling-scale (/ (sdl2:get-performance-frequency) 1000.0)))
-          ;; set up framebuffer
+           ,@(loop for system in *world-systems*
-          (gl:bind-framebuffer :framebuffer framebuf)
+                   append `((,(second system))))
 
-          (gl:bind-texture :texture-2d render-texture)
+           #|
-          (gl:tex-image-2d :texture-2d 0 :rgba *view-width* *view-height* 0 :rgba :unsigned-byte (cffi:null-pointer))
+           ;; set up framebuffer
-          (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
+           (gl:bind-framebuffer :framebuffer framebuf)
-          (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
-          (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
-          (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
-          (gl:bind-texture :texture-2d 0)
 
-          (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d render-texture 0)
+           (gl:bind-texture :texture-2d render-texture)
+           (gl:tex-image-2d :texture-2d 0 :rgba *view-width* *view-height* 0 :rgba :unsigned-byte (cffi:null-pointer))
+           (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
+           (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
+           (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
+           (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
+           (gl:bind-texture :texture-2d 0)
 
-          (gl:bind-renderbuffer :renderbuffer renderbuf)
+           (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d render-texture 0)
-          (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*)
-          (gl:bind-renderbuffer :renderbuffer 0)
 
-          (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer renderbuf)
+           (gl:bind-renderbuffer :renderbuffer renderbuf)
+           (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*)
+           (gl:bind-renderbuffer :renderbuffer 0)
 
-          ;; make sure it's valid
+           (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer renderbuf)
-          (let ((result (gl:check-framebuffer-status :framebuffer)))
-            (unless (gl::enum= result :framebuffer-complete)
-              (error "Failed to create framebuffer: ~S" result)))
 
-          (format t "texture-resident-p: ~S~%" (gl:texture-resident-p render-texture))
+           ;; make sure it's valid
+           (let ((result (gl:check-framebuffer-status :framebuffer)))
+             (unless (gl::enum= result :framebuffer-complete)
+               (error "Failed to create framebuffer: ~S" result)))
 
-          ;; set up gl
+           (format t "texture-resident-p: ~S~%" (gl:texture-resident-p render-texture))
-          (gl:matrix-mode :projection)
-          (gl:ortho 0 *view-width*
-                    0 *view-height*
-                    -1024 1024)
-          (gl:matrix-mode :modelview)
-          (gl:load-identity)
-          (gl:clear-color 0.0 0.0 0.0 1.0)
-          (gl:clear :color-buffer)
-          (gl:clear :depth-buffer)
 
-          (sdl2:with-event-loop (:method :poll)
+           ;; set up gl
-            (:quit () t)
+           (gl:matrix-mode :projection)
-            (:idle ()
+           (gl:ortho 0 *view-width*
-                   (setf prev-profiling-tick (sdl2:get-performance-counter))
+                     0 *view-height*
-                   ;; calculate delta-time
+                     -1024 1024)
-                   (setf this-tick (sdl2:get-ticks))
+           (gl:matrix-mode :modelview)
-                   (setf *delta-time* (* (- this-tick prev-tick) 0.001))
+           (gl:load-identity)
-                   (setf prev-tick this-tick)
+           (gl:clear-color 0.0 0.0 0.0 1.0)
-                   (format t "Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*))
+           (gl:clear :color-buffer)
-                   ;; update
+           (gl:clear :depth-buffer)
-                   (loop for scene in *world-scenes*
+           |#
-                         do (o! scene (update)))
-                   (format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
-                   ;; draw to render texture
-                   (gl:bind-framebuffer :framebuffer framebuf)
-                   (gl:viewport 0 0 *view-width* *view-height*)
-                   (gl:clear :color-buffer)
-                   (gl:enable :depth-test)
-                   (let ((render-pass nil))
-                     (loop for view-ptr in *world-views*
-                           for view = (ensure-live (weak-pointer-value view-ptr))
-                           when (and (o! view active-p) (o! view actor tree-active-p))
-                             do (progn
-                                  (unless (eql (o! view render-pass) render-pass)
-                                    (setf render-pass (o! view render-pass))
-                                    (gl:clear :depth-buffer))
-                                  (o! view (render-view *world-drawables*)))))
-                   (gl:flush)
-                   (format t "draw=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
 
-                   ;; now draw to window
+           (sdl2:with-event-loop (:method :poll)
-                   (gl:bind-framebuffer :framebuffer 0)
+             (:quit () t)
-                   (gl:viewport 0 0 win-width win-height)
+             (:idle ()
-                   (gl:clear :color-buffer)
+                    (setf prev-profiling-tick (sdl2:get-performance-counter))
-                   (gl:disable :depth-test)
+                    ;; calculate delta-time
-                   (gl:enable :texture-2d)
+                    (setf this-tick (sdl2:get-ticks))
-                   (gl:bind-texture :texture-2d render-texture)
+                    (setf *delta-time* (* (- this-tick prev-tick) 0.001))
-                   (gl:matrix-mode :modelview)
+                    (setf prev-tick this-tick)
-                   (gl:load-identity)
+                    (format t "~%Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*))
+                    ;; update
+                    (loop for scene in *world*
+                          do (o! scene (update)))
+                    (format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
+                    ,@(loop for system in *world-systems*
+                            append `((,(third system))
+                                     (format t ,(format nil "~S~A" (first system) "=~S ")
+                                             (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
+                                     ))
+                    #|
+                    ;; draw to render texture
+                    (gl:bind-framebuffer :framebuffer framebuf)
+                    (gl:viewport 0 0 *view-width* *view-height*)
+                    (gl:clear :color-buffer)
+                    (gl:enable :depth-test)
+                    (let ((render-pass nil))
+                      (loop for view-ptr in *world-views*
+                            for view = (ensure-live (weak-pointer-value view-ptr))
+                            when (and (o! view active-p) (o! view actor tree-active-p))
+                              do (progn
+                                   (unless (eql (o! view render-pass) render-pass)
+                                     (setf render-pass (o! view render-pass))
+                                     (gl:clear :depth-buffer))
+                                   (o! view (render-view *world-drawables*)))))
+                    (gl:flush)
+                    (format t "draw=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
 
-                   (gl:with-primitives :quads
+                    ;; now draw to window
-                     (gl:color 1.0 1.0 1.0 1.0)
+                    (gl:bind-framebuffer :framebuffer 0)
-                     (gl:tex-coord 0.0 0.0)
+                    (gl:viewport 0 0 win-width win-height)
-                     (gl:vertex 0.0 0.0)
+                    (gl:clear :color-buffer)
-                     (gl:tex-coord 1.0 0.0)
+                    (gl:disable :depth-test)
-                     (gl:vertex *view-width* 0.0)
+                    (gl:enable :texture-2d)
-                     (gl:tex-coord 1.0 1.0)
+                    (gl:bind-texture :texture-2d render-texture)
-                     (gl:vertex *view-width* *view-height*)
+                    (gl:matrix-mode :modelview)
-                     (gl:tex-coord 0.0 1.0)
+                    (gl:load-identity)
-                     (gl:vertex 0.0 *view-height*))
 
-                   (gl:disable :texture-2d)
+                    (gl:with-primitives :quads
+                      (gl:color 1.0 1.0 1.0 1.0)
+                      (gl:tex-coord 0.0 0.0)
+                      (gl:vertex 0.0 0.0)
+                      (gl:tex-coord 1.0 0.0)
+                      (gl:vertex *view-width* 0.0)
+                      (gl:tex-coord 1.0 1.0)
+                      (gl:vertex *view-width* *view-height*)
+                      (gl:tex-coord 0.0 1.0)
+                      (gl:vertex 0.0 *view-height*))
 
-                   (gl:flush)
+                    (gl:disable :texture-2d)
-                   (format t "blit=~S~%" (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
+
-                   (sdl2:gl-swap-window win)))
+                    (gl:flush)
-          )))))
+                    (format t "blit=~S~%" (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
+                    |#
+                    (sdl2:gl-swap-window win)))
+           )))))

wh-engine/package.lisp

@@ -13,10 +13,9 @@
    deref-pointer points-to ensure-live
    vxy1 vxy-trunc
    make-id fixed-id
-   *world-scenes*
+   *world*
    add-scene remove-scene get-scene update-all-scenes
    initialize-actors-in
-   *view-width* *view-height* *view-ppu* *pixel-scale*
    register-test-scene
    run
    *delta-time*
@@ -84,21 +83,6 @@
    destroy
    resume suspend
 
-   ;; render/drawable.lisp
+   ;; systems.lisp
-   drawable
+   register-system install-systems
-   ; virtual properties
-   culling-box
-   ; methods
-   draw
-
-   drawable-test
-
-   ;; render/view.lisp
-   view
-   ; properties
-   render-pass render-mask cull-p
-   ; virtual properties
-   view-matrix world-matrix
-   ; methods
-   view-point render-view render-drawable
    ))

wh-engine/render/drawable.lisp

@@ -1,11 +1,11 @@
 ;;;; wh-engine/render/drawable.lisp
-(in-package wh-engine)
+(in-package wh-engine/render)
 
 (defclass drawable (component)
   ()
   (:documentation "Base class for components that draw graphics."))
 
-(defmethod start :after ((this drawable))
+(defmethod activate :after ((this drawable) &key)
   ; Register
   (pushnew (make-weak-pointer this) *world-drawables*))
 

wh-engine/render/render-system.lisp

@@ -0,0 +1,150 @@
+;;;; wh-engine/render/render-system.lisp
+;;;; render system main code
+(defpackage wh-engine/render
+  (:nicknames whe/render)
+  (:use common-lisp 3d-vectors 3d-matrices wh-engine)
+  (:import-from sb-ext
+                weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value)
+  (:import-from objective-lisp O!)
+  (:export
+   ;; render/drawable.lisp
+   drawable
+   ; virtual properties
+   culling-box
+   ; methods
+   draw
+
+   drawable-test
+
+   ;; render/view.lisp
+   view
+   ; properties
+   render-pass render-mask cull-p
+   ; virtual properties
+   view-matrix world-matrix
+   ; methods
+   view-point render-view render-drawable
+
+   *view-width* *view-height* *view-ppu* *pixel-scale*))
+
+(in-package wh-engine/render)
+
+(defun opengl-matrix (matrix)
+  (declare (type mat3 matrix))
+  (with-fast-matref (m matrix 3)
+    (make-array '(16) :initial-contents
+                `(,(m 0 0) ,(m 0 1) 0.0 ,(m 0 2)
+                  ,(m 1 0) ,(m 1 1) 0.0 ,(m 1 2)
+                      0.0      0.0  1.0     0.0
+                  ,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
+                )))
+
+(defvar *view-width* 384
+  "View-space width in pixels.")
+(defvar *view-height* 256
+  "View-space height in pixels.")
+(defvar *view-ppu* 64
+  "Pixels in view-space per unit in world-space.")
+
+(defvar *pixel-scale* 2
+  "Scaling factor for rendered pixels.")
+
+(defvar *world-drawables* ()
+  "List of all known drawables.")
+(defvar *world-views* ()
+  "List of all known views.")
+
+(defun sort-world-views ()
+  "Re-sort the *world-views* list by render pass."
+  (sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))
+
+(let (framebuf renderbuf render-texture win-width win-height)
+  (defun render-system-init ()
+    (setf win-width (* *view-width* *pixel-scale*)
+          win-height (* *view-height* *pixel-scale*)
+          framebuf (gl:gen-framebuffer)
+          renderbuf (gl:gen-renderbuffer)
+          render-texture (gl:gen-texture))
+
+    ;; set up framebuffer
+    (gl:bind-framebuffer :framebuffer framebuf)
+
+    (gl:bind-texture :texture-2d render-texture)
+    (gl:tex-image-2d :texture-2d 0 :rgba *view-width* *view-height* 0 :rgba :unsigned-byte (cffi:null-pointer))
+    (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
+    (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
+    (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
+    (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
+    (gl:bind-texture :texture-2d 0)
+
+    (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d render-texture 0)
+
+    (gl:bind-renderbuffer :renderbuffer renderbuf)
+    (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*)
+    (gl:bind-renderbuffer :renderbuffer 0)
+
+    (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer renderbuf)
+
+    ;; make sure it's valid
+    (let ((result (gl:check-framebuffer-status :framebuffer)))
+      (unless (gl::enum= result :framebuffer-complete)
+        (error "Failed to create framebuffer: ~S" result)))
+
+    (format t "texture-resident-p: ~S~%" (gl:texture-resident-p render-texture))
+
+    ;; set up gl
+    (gl:matrix-mode :projection)
+    (gl:ortho 0 *view-width*
+              0 *view-height*
+              -1024 1024)
+    (gl:matrix-mode :modelview)
+    (gl:load-identity)
+    (gl:clear-color 0.0 0.0 0.0 1.0)
+    (gl:clear :color-buffer)
+    (gl:clear :depth-buffer))
+
+  (defun render-system-update ()
+    ;; draw to render texture
+    (gl:bind-framebuffer :framebuffer framebuf)
+    (gl:viewport 0 0 *view-width* *view-height*)
+    (gl:clear :color-buffer)
+    (gl:enable :depth-test)
+    (let ((render-pass nil))
+      (loop for view-ptr in *world-views*
+            for view = (ensure-live (weak-pointer-value view-ptr))
+            when (and (o! view active-p) (o! view actor tree-active-p))
+              do (progn
+                   (unless (eql (o! view render-pass) render-pass)
+                     (setf render-pass (o! view render-pass))
+                     (gl:clear :depth-buffer))
+                   (o! view (render-view *world-drawables*)))))
+    (gl:flush)
+
+    ;; now draw to window
+    (gl:bind-framebuffer :framebuffer 0)
+    (gl:viewport 0 0 win-width win-height)
+    (gl:clear :color-buffer)
+    (gl:disable :depth-test)
+    (gl:enable :texture-2d)
+    (gl:bind-texture :texture-2d render-texture)
+    (gl:matrix-mode :modelview)
+    (gl:load-identity)
+
+    (gl:with-primitives :quads
+      (gl:color 1.0 1.0 1.0 1.0)
+      (gl:tex-coord 0.0 0.0)
+      (gl:vertex 0.0 0.0)
+      (gl:tex-coord 1.0 0.0)
+      (gl:vertex *view-width* 0.0)
+      (gl:tex-coord 1.0 1.0)
+      (gl:vertex *view-width* *view-height*)
+      (gl:tex-coord 0.0 1.0)
+      (gl:vertex 0.0 *view-height*))
+
+    (gl:disable :texture-2d)
+
+    (gl:flush)))
+
+(register-system :wh-engine/render 'render-system-init 'render-system-update nil)
+
+(install-systems :wh-engine/render)

wh-engine/render/view.lisp

@@ -1,9 +1,5 @@
 ;;;; wh-engine/render/view.lisp
-(in-package wh-engine)
+(in-package wh-engine/render)
-
-(defun sort-world-views ()
-  "Re-sort the *world-views* list by render pass."
-  (sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))
 
 (defclass view (component)
   ((render-pass :documentation "The render pass this view should be drawn in."

wh-engine/scene.lisp

@@ -84,3 +84,17 @@
   (loop for actor in (o! this actors)
         unless (o! actor :slot parent)
           do (o! actor (suspend))))
+
+(defun add-scene (scene)
+  "Add a scene to the list of running scenes."
+  (declare (type scene scene))
+
+  (push scene *world*)
+  scene)
+
+(defun remove-scene (scene)
+  "Remove a scene from the list of running scenes."
+  (declare (type scene scene))
+
+  (setf *world* (remove scene *world*))
+  scene)

wh-engine/systems.lisp

@@ -0,0 +1,17 @@
+;;;; wh-engine/systems.lisp
+;;;; facilities for defining systems
+(in-package wh-engine)
+
+(defvar *system-registry* ()
+  "Alist of defined systems.")
+
+(defvar *world-systems* ()
+  "List of enabled systems.")
+
+(defun register-system (name init-fun-symbol update-fun-symbol sdl-event-rules)
+  (push `(,name ,init-fun-symbol ,update-fun-symbol ,sdl-event-rules) *system-registry*))
+
+(defun install-systems (&rest systems)
+  (loop for system-name in systems
+        for system = (assoc system-name *system-registry*)
+        do (push system *world-systems*)))