diff --git a/wh-engine.asd b/wh-engine.asd index 115a466..98b3adc 100644 --- a/wh-engine.asd +++ b/wh-engine.asd @@ -10,11 +10,13 @@ :components ((:module "wh-engine" :components ((:file "package") - (:file "main") + (:file "global") (:file "serialization") (:file "actor") (:file "component") + (:file "actor-macros") (:file "scene") (:file "render/drawable") - (:file "render/view")) + (:file "render/view") + (:file "main")) ))) diff --git a/wh-engine/actor-macros.lisp b/wh-engine/actor-macros.lisp new file mode 100644 index 0000000..e196e0c --- /dev/null +++ b/wh-engine/actor-macros.lisp @@ -0,0 +1,66 @@ + ;;;; wh-engine/actor-macros.lisp +(in-package wh-engine) + +(defvar *new!-impl-alist* () + "Alist of special implementations for new!") + +(defmacro define-new!-impl (class (class-var it-var params-var) &body body) + "Define a special implementation for new!, which returns (values other-forms make-params)." + `(push (cons (find-class ',class) + (lambda (,class-var ,it-var ,params-var) ,@body)) + *new!-impl-alist*)) + +(defmacro new! (class &rest params &key &allow-other-keys) + "Create a new instance of class, as specified by params." + (let ((impl (cdr (assoc-if (lambda (x) (subtypep x class)) *new!-impl-alist*))) + (it (gensym))) + (if impl + (multiple-value-bind (other-forms make-params) + (funcall impl class it params) + `(let ((,it (make-instance ',class ,@make-params))) ,@other-forms ,it)) + `(make-instance ',class ,@params)) + )) + +(define-new!-impl actor (class it params) + (declare (ignore class)) + (loop for (key value) on params by #'cddr + if (eq key :component) + collect `(o! ,it (add-component ,value)) into other-forms + else + if (eq key :child) + collect `(o! ,it (add-child ,value)) into other-forms + else + if (eq key :parent) + collect `(o! ,value (add-child ,it)) into other-forms + else + nconc `(,key ,value) into make-params + finally (return (values other-forms make-params)))) + +#| +(define-new!-impl component (class it params) + (loop for (key value) on params by #'cddr + if (eq key :actor) + collect `(o! ,value (add-component ,it)) into other-forms + else + nconc `(,key ,value) into make-params + finally (return (values other-forms make-params)))) +|# + +#| +(defmacro actor! (class &rest params &key &allow-other-keys) + (let* ((cons-form `(make-instance ',class)) + (it (gensym)) + (other-forms + (loop for (key value) on params by #'cddr + if (eq key :component) + collect `(o! ,it (add-component ,value)) + else + if (eq key :child) + collect `(o! ,it (add-child ,value)) + else + do (nconc cons-form `(,key ,value))))) + `(let ((,it ,cons-form)) ,@other-forms ,it))) + +(defmacro component! (class &rest params &key &allow-other-keys) + `(make-instance ',class ,@params)) +|# diff --git a/wh-engine/global.lisp b/wh-engine/global.lisp new file mode 100644 index 0000000..1ba932b --- /dev/null +++ b/wh-engine/global.lisp @@ -0,0 +1,157 @@ +;;;; wh-engine/global.lisp +;;;; global variables and utility functions +(in-package wh-engine) + +;; FIXME this should be a defconst +(defvar +version+ (list 0 1 0) + "Engine version.") + +(defun ensure-version (expected-version) + "Ensure this version of wh-engine is compatible with the expected version." + (if (= (nth 0 +version+) 0) + (unless (equal +version+ expected-version) + (error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)" + +version+ expected-version)) + (progn + (unless (= (nth 0 +version+) (nth 0 expected-version)) + (error "engine version ~S incompatible with expected-version ~S (major-version mismatch)" + +version+ expected-version)) + (unless (>= (nth 1 +version+) (nth 1 expected-version)) + (error "engine version ~S incompatible with expected-version ~S (minor-version too low)" + +version+ expected-version)) + (unless (equal +version+ expected-version) + (warn "engine version ~S differs from expected-version ~S, but is still compatible" + +version+ expected-version))))) + +(declaim (inline deref-pointer)) +(defun deref-pointer (ptr) + "Dereference ptr if it's non-nil." + (declare (type (or weak-pointer null) ptr)) + (when ptr (weak-pointer-value ptr))) + +(defun points-to (ptr obj) + "Return true if ptr points to obj." + (declare (type weak-pointer ptr)) + + (eq (weak-pointer-value ptr) obj)) + +(defun ensure-live (obj) + "Ensure obj is live (non-destroyed)." + (when (o! obj destroyed-p) + (error "~S was used after it was destroyed" obj)) + obj) + +(declaim (inline vxy1)) +(defun vxy1 (vector) + "Convert vector to a vec3, with a Z component of 1." + (declare (type vec2 vector)) + (vec3 (vx2 vector) (vy2 vector) 1)) + +(declaim (inline vxy-trunc)) +(defun vxy-trunc (vector) + "Convert vector to a vec2 and truncate its X and Y components to the nearest integer." + (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.") + +(defun make-id () + "Return a unique ID." + (setf *id-counter* (+ *id-counter* 1))) + +(defun fixed-id (id) + "Ensure the given ID won't be returned by make-id." + (declare (type fixnum id)) + + (when (>= id *id-counter*) + (setf *id-counter* (+ id 1))) + id) + +(defstruct id-ref + (scene 0 :type fixnum) + (actor nil :type (or fixnum null)) + (component nil :type (or symbol null))) + +(deftype pointer () '(or id-ref weak-pointer null)) + +(declaim (inline deref-sus-pointer)) +(defun deref-sus-pointer (val) + "Dereference val, and warn if it's suspended." + (declare (type pointer val)) + (etypecase val + (weak-pointer (weak-pointer-value val)) + (id-ref (warn "dereferencing sus pointer ~S" val) + (weak-pointer-value (pointerize val))) + (null nil))) + +(defun referize (ptr) + "Convert ptr into an id-ref." + + (let ((target (etypecase ptr + (weak-pointer (weak-pointer-value ptr)) + ((or scene actor component) ptr)))) + (etypecase target + (scene + (make-id-ref :scene (o! target id))) + (actor + (make-id-ref :scene (etypecase (o! target :slot scene) + (weak-pointer (o! target scene id)) + (id-ref (id-ref-scene (o! target :slot scene)))) + :actor (o! target id))) + (component + (make-id-ref :scene (etypecase (o! target :slot actor) + (weak-pointer (o! target scene id)) + (id-ref (id-ref-scene (o! target :slot actor)))) + :actor (etypecase (o! target :slot actor) + (weak-pointer (o! target actor id)) + (id-ref (id-ref-actor (o! target :slot actor)))) + :component (class-name (class-of target)))) + ))) + +(defun dereferize (ref) + "Return the object specified by id-ref ref." + (declare (type id-ref ref)) + + (let ((scene (get-scene (id-ref-scene ref))) actor component) + (unless scene + (error "can't dereferize ~S (scene not found)" ref)) + (if (id-ref-actor ref) + (if (setf actor (o! scene (get-actor (id-ref-actor ref)))) + (if (id-ref-component ref) + (if (setf component (o! actor (get-component (find-class (id-ref-component ref))))) + component + (error "can't dereferize ~S (component not found)" ref)) + actor) + (error "can't dereferize ~S (actor not found)" ref)) + scene))) + +(defun pointerize (ref) + "Convert id-ref ref into a weak-pointer." + (declare (type id-ref ref)) + + (make-weak-pointer (dereferize ref))) + +(defmacro referize-setf (place) + `(when (typep ,place 'weak-pointer) + (setf ,place (referize ,place)))) +(defmacro pointerize-setf (place) + `(when (typep ,place 'id-ref) + (setf ,place (pointerize ,place)))) + +(defvar *world-scenes* () + "List of all running scenes.") + +(defun get-scene (scene-id) + "Get a scene by its ID." + (find-if (lambda (scene) (eq (o! scene id) scene-id)) *world-scenes*)) diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index 211c8d9..c4cc9c8 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -1,85 +1,6 @@ ;;;; wh-engine/main.lisp (in-package wh-engine) -;; FIXME this should be a defconst -(defvar +version+ (list 0 1 0) - "Engine version.") - -(defun ensure-version (expected-version) - "Ensure this version of wh-engine is compatible with the expected version." - (if (= (nth 0 +version+) 0) - (unless (equal +version+ expected-version) - (error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)" - +version+ expected-version)) - (progn - (unless (= (nth 0 +version+) (nth 0 expected-version)) - (error "engine version ~S incompatible with expected-version ~S (major-version mismatch)" - +version+ expected-version)) - (unless (>= (nth 1 +version+) (nth 1 expected-version)) - (error "engine version ~S incompatible with expected-version ~S (minor-version too low)" - +version+ expected-version)) - (unless (equal +version+ expected-version) - (warn "engine version ~S differs from expected-version ~S, but is still compatible" - +version+ expected-version))))) - -(declaim (inline deref-pointer)) -(defun deref-pointer (ptr) - "Dereference ptr if it's non-nil." - (declare (type (or weak-pointer null) ptr)) - (when ptr (weak-pointer-value ptr))) - -(defun points-to (ptr obj) - "Return true if ptr points to obj." - (declare (type weak-pointer ptr)) - - (eq (weak-pointer-value ptr) obj)) - -(defun ensure-live (obj) - "Ensure obj is live (non-destroyed)." - (when (o! obj destroyed-p) - (error "~S was used after it was destroyed" obj)) - obj) - -(declaim (inline vxy1)) -(defun vxy1 (vector) - "Convert vector to a vec3, with a Z component of 1." - (declare (type vec2 vector)) - (vec3 (vx2 vector) (vy2 vector) 1)) - -(declaim (inline vxy-trunc)) -(defun vxy-trunc (vector) - "Convert vector to a vec2 and truncate its X and Y components to the nearest integer." - (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.") - -(defun make-id () - "Return a unique ID." - (setf *id-counter* (+ *id-counter* 1))) - -(defun fixed-id (id) - "Ensure the given ID won't be returned by make-id." - (declare (type fixnum id)) - - (when (>= id *id-counter*) - (setf *id-counter* (+ id 1))) - id) - -(defvar *world-scenes* () - "List of all running scenes.") - (defun add-scene (scene) "Add a scene to the list of running scenes." (declare (type scene scene)) @@ -94,10 +15,6 @@ (setf *world-scenes* (remove scene *world-scenes*)) scene) -(defun get-scene (scene-id) - "Get a scene by its ID." - (find-if (lambda (scene) (eq (o! scene id) scene-id)) *world-scenes*)) - (defun initialize-actors-in (scene &rest actors) "Properly attach actors and their descendents to scene, and initialize them." (loop for actor in actors @@ -127,62 +44,36 @@ (defvar *world-views* nil "List of all known views.") +(defvar *delta-time* 0.0 + "Time in seconds since the last game tick.") + (defun register-test-scene () - (let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view child-actor grandchild-actor) - (setf test-scene (make-instance 'scene - :id -1 - :name "Test scene")) + (let ((test-scene (new! scene :id -1 :name "Test scene"))) (add-scene test-scene) - - (setf test-actor (make-instance 'actor - :name "Actor")) - ;; (o! test-scene (add-actor test-actor)) - - (setf test-drawable (make-instance 'drawable-test)) - (o! test-actor (add-component test-drawable)) - - (setf test-actor-2 (make-instance 'actor - :name "Actor 2" - :location (vec2 0.5 0.5) - :rotation (coerce (/ pi 4) 'single-float) - :z-layer -1)) - ;; (o! test-scene (add-actor test-actor-2)) - - (o! test-actor-2 (add-component (make-instance 'drawable-test - :colour (vec4 0.0 1.0 0.0 1.0)))) - - (setf child-actor (make-instance 'actor - :name "Child Actor" - :location (vec2 0 0.5) - :z-layer -2)) - ;; (o! test-scene (add-actor child-actor)) - (o! test-actor-2 (add-child child-actor)) - - (o! child-actor (add-component (make-instance 'drawable-test - :colour (vec4 0.0 1.0 1.0 1.0)))) - - (setf grandchild-actor (make-instance 'actor - :name "Grandchild Actor" - :location (vec2 0 1) - :scale (vec2 0.25 0.25) - :z-layer 1)) - ;; (o! test-scene (add-actor grandchild-actor)) - (o! child-actor (add-child grandchild-actor)) - - (o! grandchild-actor (add-component (make-instance 'drawable-test - :colour (vec4 1.0 1.0 0.0 0.0)))) - - (setf camera-actor (make-instance 'actor - :name "Camera")) - ;; (o! test-scene (add-actor camera-actor)) - - (setf camera-view (make-instance 'view)) - (o! camera-actor (add-component camera-view)) - - ;;(sb-ext:gc) (initialize-actors-in test-scene - test-actor test-actor-2 camera-actor) - + (new! actor + :name "Actor" + :component (new! 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)) + :child (new! actor + :name "Child Actor" + :location (vec2 0 0.5) + :z-layer -2 + :component (new! 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))))) + (new! actor + :name "Camera" + :component (new! view))) test-scene)) (defun run () @@ -203,7 +94,11 @@ (renderbuf (gl:gen-renderbuffer)) (render-texture (gl:gen-texture)) (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)) + (this-tick (sdl2:get-ticks)) + (prev-profiling-tick (sdl2:get-performance-counter)) + (profiling-scale (/ (sdl2:get-performance-frequency) 1000.0))) ;; set up framebuffer (gl:bind-framebuffer :framebuffer framebuf) @@ -244,9 +139,16 @@ (sdl2:with-event-loop (:method :poll) (:quit () t) (:idle () + (setf prev-profiling-tick (sdl2:get-performance-counter)) + ;; calculate delta-time + (setf this-tick (sdl2:get-ticks)) + (setf *delta-time* (* (- this-tick prev-tick) 0.001)) + (setf prev-tick this-tick) + (format t "Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*)) ;; update (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*) @@ -261,6 +163,8 @@ (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 (gl:bind-framebuffer :framebuffer 0) @@ -272,7 +176,7 @@ (gl:matrix-mode :modelview) (gl:load-identity) - (gl:with-primitive :quads + (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) @@ -286,5 +190,6 @@ (gl:disable :texture-2d) (gl:flush) + (format t "blit=~S~%" (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) (sdl2:gl-swap-window win))) ))))) diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp index c695591..4fdbaf8 100644 --- a/wh-engine/package.lisp +++ b/wh-engine/package.lisp @@ -19,6 +19,7 @@ *view-width* *view-height* *view-ppu* *pixel-scale* register-test-scene run + *delta-time* ;; serialization.lisp id-ref make-id-ref @@ -68,6 +69,10 @@ start update destroy + ;; actor-macros.lisp + new! + define-new!-impl + ;; scene.lisp scene ; properties diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp index 313f0bd..0e52b19 100644 --- a/wh-engine/serialization.lisp +++ b/wh-engine/serialization.lisp @@ -1,77 +1,6 @@ ;;;; wh-engine/serialization.lisp (in-package wh-engine) -(defstruct id-ref - (scene 0 :type fixnum) - (actor nil :type (or fixnum null)) - (component nil :type (or symbol null))) - -(deftype pointer () '(or id-ref weak-pointer null)) - -(declaim (inline deref-sus-pointer)) -(defun deref-sus-pointer (val) - "Dereference val, and warn if it's suspended." - (declare (type pointer val)) - (etypecase val - (weak-pointer (weak-pointer-value val)) - (id-ref (warn "dereferencing sus pointer ~S" val) - (weak-pointer-value (pointerize val))) - (null nil))) - -(defun referize (ptr) - "Convert ptr into an id-ref." - - (let ((target (etypecase ptr - (weak-pointer (weak-pointer-value ptr)) - ((or scene actor component) ptr)))) - (etypecase target - (scene - (make-id-ref :scene (o! target id))) - (actor - (make-id-ref :scene (etypecase (o! target :slot scene) - (weak-pointer (o! target scene id)) - (id-ref (id-ref-scene (o! target :slot scene)))) - :actor (o! target id))) - (component - (make-id-ref :scene (etypecase (o! target :slot actor) - (weak-pointer (o! target scene id)) - (id-ref (id-ref-scene (o! target :slot actor)))) - :actor (etypecase (o! target :slot actor) - (weak-pointer (o! target actor id)) - (id-ref (id-ref-actor (o! target :slot actor)))) - :component (class-name (class-of target)))) - ))) - -(defun dereferize (ref) - "Return the object specified by id-ref ref." - (declare (type id-ref ref)) - - (let ((scene (get-scene (id-ref-scene ref))) actor component) - (unless scene - (error "can't dereferize ~S (scene not found)" ref)) - (if (id-ref-actor ref) - (if (setf actor (o! scene (get-actor (id-ref-actor ref)))) - (if (id-ref-component ref) - (if (setf component (o! actor (get-component (find-class (id-ref-component ref))))) - component - (error "can't dereferize ~S (component not found)" ref)) - actor) - (error "can't dereferize ~S (actor not found)" ref)) - scene))) - -(defun pointerize (ref) - "Convert id-ref ref into a weak-pointer." - (declare (type id-ref ref)) - - (make-weak-pointer (dereferize ref))) - -(defmacro referize-setf (place) - `(when (typep ,place 'weak-pointer) - (setf ,place (referize ,place)))) -(defmacro pointerize-setf (place) - `(when (typep ,place 'id-ref) - (setf ,place (pointerize ,place)))) - (defun replace-in-tree (tree atom-fun) (if (consp (car tree)) (replace-in-tree (car tree) atom-fun)