diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp index 2dccec8..7d9470c 100644 --- a/wh-engine/actor.lisp +++ b/wh-engine/actor.lisp @@ -78,202 +78,191 @@ (defmethod scene ((this actor)) "The scene containing this actor." - (deref-sus-pointer [this :slot scene])) + (deref-sus-pointer (o! this :slot scene))) (defmethod parent ((this actor)) "This actor's parent." - (deref-sus-pointer [this :slot parent])) + (deref-sus-pointer (o! this :slot parent))) (defmethod tree-active-p ((this actor)) "Whether or not this actor and all its parents are active." - (and [this active-p] (not [this :slot blocked-p]))) + (and (o! this active-p) (not (o! this :slot blocked-p)))) (defmethod apply-to-tree ((this actor) fun) (funcall fun this) - (loop for child-ptr in [this children] + (loop for child-ptr in (o! this children) when (typep child-ptr 'weak-pointer) - do [(weak-pointer-value child-ptr) (apply-to-tree fun)])) + do (o! (weak-pointer-value child-ptr) (apply-to-tree fun)))) (defmethod print-object ((this actor) stream) (print-unreadable-object (this stream :type t :identity t) - (prin1 [this :slot id] stream) + (prin1 (o! this :slot id) stream) (princ " ") - (prin1 [this :slot name] stream))) + (prin1 (o! this :slot name) stream))) (defmethod get-component ((this actor) component-class) "Get a component of the specified class attached to this object." (find-if (lambda (component) (typep component component-class)) - [this components])) + (o! this components))) (defmethod add-component ((this actor) component) "Add a component to this object." (let ((component-class (class-of component))) - (when [this (get-component component-class)] + (when (o! this (get-component component-class)) (error "~S already has a component of class ~S" this component-class)) - (push component [this :slot components]) - [component (attach this)]) + (push component (o! this :slot components)) + (o! component (attach this))) component) (defmethod add-child ((this actor) child) "Add a child to this object." - (when [child parent] - (error "~S is already a child of ~S" child [child parent])) - (push (make-weak-pointer child) [this :slot children]) - (setf [child :slot parent] (make-weak-pointer this)) - [child (parent-changed)] + (when (o! child parent) + (error "~S is already a child of ~S" child (o! child parent))) + (push (make-weak-pointer child) (o! this :slot children)) + (setf (o! child :slot parent) (make-weak-pointer this)) + (o! child (parent-changed)) child) (defmethod remove-child ((this actor) child) "Remove a child from this object." - (unless (eq [child parent] this) + (unless (eq (o! child parent) this) (error "~S is not a child of ~S" child this)) - (setf [this :slot children] (delete child [this :slot children] :key #'deref-sus-pointer :count 1)) - (setf [child :slot parent] nil) - [child (parent-changed)] + (setf (o! this :slot children) (delete child (o! this :slot children) :key #'deref-sus-pointer :count 1)) + (setf (o! child :slot parent) nil) + (o! child (parent-changed)) child) (defmethod recompute-blocked-p ((this actor)) "Determine if any ancestors of this actor are deactivated." - (setf [this :slot blocked-p] - (when [this parent] (or (not [this parent active-p]) [this parent :slot blocked-p])))) + (setf (o! this :slot blocked-p) + (when (o! this parent) (or (not (o! this parent active-p)) (o! this parent :slot blocked-p))))) (defmethod has-tag ((this actor) tag) "Check if this object has the specified tag." - (find tag [this tags])) + (find tag (o! this tags))) (defmethod add-tag ((this actor) tag) "Add a tag to this object." - (pushnew tag [this :slot tags])) + (pushnew tag (o! this :slot tags))) (defmethod remove-tag ((this actor) tag) "Remove a tag from this object." - (setf [this :slot tags] (remove tag [this :slot tags]))) - -(defmethod parent-deactivated ((this actor) parent) - "Called when the actor's parent is deactivated." - [this (recompute-blocked-p)] - (loop for component in [this components] - do [component (parent-deactivated parent)]) - (loop for child-ptr in [this children] - for child = (weak-pointer-value child-ptr) - do [child (parent-deactivated parent)])) - -(defmethod parent-activated ((this actor) parent) - "Called when the actor's parent is activated." - [this (recompute-blocked-p)] - (when [this tree-active-p] - (loop for child-ptr in [this children] - for child = (weak-pointer-value child-ptr) - do [child (parent-activated parent)]) - (loop for component in [this components] - do [component (parent-activated parent)]))) + (setf (o! this :slot tags) (remove tag (o! this :slot tags)))) (defmethod parent-changed ((this actor)) "Called when the actor's parent is changed." - [this (recompute-blocked-p)] - (loop for component in [this components] - do [component (parent-changed)])) + (o! this (recompute-blocked-p)) + (loop for component in (o! this components) + do (o! component (parent-changed)))) -(defmethod deactivate ((this actor)) +(defmethod deactivate ((this actor) &key origin) "Deactivate this object." - (setf [this :slot active-p] nil) - (loop for component in [this components] - do [component (parent-deactivated this)]) - (loop for child-ptr in [this children] + (o! this (recompute-blocked-p)) + (unless origin + (setf (o! this :slot active-p) nil)) + (loop for component in (o! this components) + do (o! component (deactivate :origin (or origin this)))) + (loop for child-ptr in (o! this children) for child = (weak-pointer-value child-ptr) - do [child (parent-deactivated this)])) + do (o! child (deactivate :origin (or origin this))))) -(defmethod activate ((this actor)) +(defmethod activate ((this actor) &key origin) "Activate this object." - (setf [this :slot active-p] t) - (loop for child-ptr in [this children] - for child = (weak-pointer-value child-ptr) - do [child (parent-activated this)]) - (loop for component in [this components] - do [component (parent-activated this)])) + (o! this (recompute-blocked-p)) + (unless origin + (setf (o! this :slot active-p) t)) + (when (o! this tree-active-p) + (loop for child-ptr in (o! this children) + for child = (weak-pointer-value child-ptr) + when (o! child active-p) + do (o! child (activate :origin (or origin this)))) + (loop for component in (o! this components) + when (o! component active-p) + do (o! component (activate :origin (or origin this)))) + )) (defmethod resume ((this actor)) "Initialize or restore this actor's state." ;; Restore self - (when (typep [this :slot scene] 'id-ref) + (when (typep (o! this :slot scene) 'id-ref) ;; relink to scene - (let ((scene (get-scene (id-ref-scene [this :slot scene])))) - (setf [this :slot scene] nil) - [scene (add-actor this)])) - (when (typep [this :slot parent] 'id-ref) + (let ((scene (get-scene (id-ref-scene (o! this :slot scene))))) + (setf (o! this :slot scene) nil) + (o! scene (add-actor this)))) + (when (typep (o! this :slot parent) 'id-ref) ;; relink to parent - (let ((parent [this scene (get-actor (id-ref-actor [this :slot parent]))])) - (setf [this :slot parent] nil) - [parent (add-child this)])) - (loop for entry on [this :slot children] + (let ((parent (o! this scene (get-actor (id-ref-actor (o! this :slot parent)))))) + (setf (o! this :slot parent) nil) + (o! parent (add-child this)))) + (loop for entry on (o! this :slot children) when (typep (car entry) 'id-ref) do (rplaca entry (pointerize (car entry)))) ;; Restore components - (loop for component in [this components] - do [component (resume)]) + (loop for component in (o! this components) + do (o! component (resume))) ;; Restore children - (loop for child-ptr in [this children] + (loop for child-ptr in (o! this children) for child = (weak-pointer-value child-ptr) - do [child (resume)])) + do (o! child (resume)))) (defmethod suspend ((this actor)) "Prepare this actor for serialization." ;; Suspend children - (loop for child-ptr in [this children] + (loop for child-ptr in (o! this children) for child = (weak-pointer-value child-ptr) - do [child (suspend)]) + do (o! child (suspend))) ;; Suspend components - (loop for component in [this components] - do [component (suspend)]) + (loop for component in (o! this components) + do (o! component (suspend))) ;; Suspend self - (loop for child-cell on [this :slot children] + (loop for child-cell on (o! this :slot children) when (typep (car child-cell) 'weak-pointer) do (rplaca child-cell (referize (car child-cell)))) - (referize-setf [this :slot scene]) - (referize-setf [this :slot parent])) + (referize-setf (o! this :slot scene)) + (referize-setf (o! this :slot parent))) (defmethod update ((this actor)) "Update this actor's components." - (loop for component in [this components] - do (when [component active-p] - (unless [component started-p] [component (start)]) - [component (update)])) -; (loop for child in [this children] -; do (when [child active-p] -; [child (.update)])) + (loop for component in (o! this components) + do (when (o! component active-p) + (unless (o! component started-p) (o! component (start))) + (o! component (update)))) +; (loop for child in (o! this children) +; do (when (o! child active-p) +; (o! child (update)))) ) (defmethod destroy ((this actor)) "Mark this object for unloading." - (unless [this destroyed-p] + (unless (o! this destroyed-p) ; Cleanup on aisle 5! - (loop for component in [this components] - when [component active-p] - do [component (destroy)]) + (loop for component in (o! this components) + when (o! component active-p) + do (o! component (destroy))) ; Remove from parent - (when [this parent] - [this parent (remove-child this)]) - (loop for child-ptr in [this children] + (when (o! this parent) + (o! this parent (remove-child this))) + (loop for child-ptr in (o! this children) for child = (deref-sus-pointer child-ptr) - do [child (destroy)]) - (when [this scene] - [this scene (remove-actor this)])) - (setf [this :slot destroyed-p] t)) + do (o! child (destroy))) + (when (o! this scene) + (o! this scene (remove-actor this)))) + (setf (o! this :slot destroyed-p) t)) ;; Transform (defmethod initialize-instance :after ((this actor) &key) - [this (recompute-matrix)]) + (o! this (recompute-matrix))) (defmethod recompute-matrix ((this actor)) "Recompute the local-to-parent-space matrix." - (let ((rs (sin [this rotation])) - (rc (cos [this rotation])) - (sx (vx2 [this scale])) - (sy (vy2 [this scale])) - (tx (vx2 [this location])) - (ty (vy2 [this location]))) - (with-fast-matref (m [this :slot matrix] 3) + (let ((rs (sin (o! this rotation))) + (rc (cos (o! this rotation))) + (sx (vx2 (o! this scale))) + (sy (vy2 (o! this scale))) + (tx (vx2 (o! this location))) + (ty (vy2 (o! this location)))) + (with-fast-matref (m (o! this :slot matrix) 3) (setf (m 0 0) (* sx rc) (m 0 1) (* sy (- rs)) (m 0 2) tx @@ -286,83 +275,83 @@ "The actor's location relative to its parent." (declare (type vec2 new-val)) - (setf (vx2 [this :slot location]) (vx2 new-val) - (vy2 [this :slot location]) (vy2 new-val)) - [this (recompute-matrix)]) + (setf (vx2 (o! this :slot location)) (vx2 new-val) + (vy2 (o! this :slot location)) (vy2 new-val)) + (o! this (recompute-matrix))) (defmethod (setf rotation) (new-val (this actor)) "The actor's rotation relative to its parent." (declare (type single-float new-val)) - (setf [this :slot rotation] new-val) - [this (recompute-matrix)]) + (setf (o! this :slot rotation) new-val) + (o! this (recompute-matrix))) (defmethod (setf scale) (new-val (this actor)) "The actor's scale relative to its parent." (declare (type vec2 new-val)) - (setf (vx2 [this :slot scale]) (vx2 new-val) - (vy2 [this :slot scale]) (vy2 new-val)) - [this (recompute-matrix)]) + (setf (vx2 (o! this :slot scale)) (vx2 new-val) + (vy2 (o! this :slot scale)) (vy2 new-val)) + (o! this (recompute-matrix))) (defmethod world-matrix ((this actor)) "The local-to-world-space transformation matrix for this actor." - (if [this parent] - (m* [this parent world-matrix] [this matrix]) - [this matrix])) + (if (o! this parent) + (m* (o! this parent world-matrix) (o! this matrix)) + (o! this matrix))) (defmethod local-matrix ((this actor)) "The world-to-local-space transformation matrix for this actor." - (minv [this world-matrix])) + (minv (o! this world-matrix))) (defmethod world-location ((this actor)) "The world-space location of this actor." - (vxy (m* [this world-matrix] (vec3 0 0 1)))) + (vxy (m* (o! this world-matrix) (vec3 0 0 1)))) (defmethod transform-point ((this actor) point) "Transform point from local space to parent space." (declare (type vec2 point)) - (vxy (m* [this matrix] (vxy1 point)))) + (vxy (m* (o! this matrix) (vxy1 point)))) (defmethod world-point ((this actor) point) "Transform point from local space to world space." (declare (type vec2 point)) - (vxy (m* [this world-matrix] (vxy1 point)))) + (vxy (m* (o! this world-matrix) (vxy1 point)))) (defmethod local-point ((this actor) point) "Transform point from world space to local space." (declare (type vec2 point)) - (vxy (m* [this local-matrix] (vxy1 point)))) + (vxy (m* (o! this local-matrix) (vxy1 point)))) (defmethod transform-svector ((this actor) vector) "Transform vector from local space to parent space." (declare (type vec2 vector)) - (vxy (m* [this matrix] (vxy_ vector)))) + (vxy (m* (o! this matrix) (vxy_ vector)))) (defmethod transform-vector ((this actor) vector) "Transform vector from local space to parent space, without changing its length." (declare (type vec2 vector)) - (nvscale [this (transform-svector vector)] (vlength vector))) + (nvscale (o! this (transform-svector vector)) (vlength vector))) (defmethod translate-by ((this actor) vector) "Translate this actor by the given vector in parent space." (declare (type vec2 vector)) - (setf [this location] (v+ [this location] vector))) + (setf (o! this location) (v+ (o! this location) vector))) (defmethod rotate-by ((this actor) angle) "Rotate this actor by the given angle." (declare (type single-float angle)) - (setf [this rotation] (+ [this rotation] angle))) + (setf (o! this rotation) (+ (o! this rotation) angle))) (defmethod scale-by ((this actor) factor) "Scale this actor by the given factor (either a scalar or a vector)." (declare (type (or single-float vec2) factor)) - (setf [this scale] (v* [this scale] factor))) + (setf (o! this scale) (v* (o! this scale) factor))) diff --git a/wh-engine/component.lisp b/wh-engine/component.lisp index 9ed9974..3244522 100644 --- a/wh-engine/component.lisp +++ b/wh-engine/component.lisp @@ -22,40 +22,34 @@ (defmethod actor ((this component)) "The actor this component belongs to." - (deref-sus-pointer [this :slot actor])) + (deref-sus-pointer (o! this :slot actor))) (defmethod scene ((this component)) "The scene this component belongs to." - [this actor scene]) + (o! this actor scene)) (defmethod destroyed-p ((this component)) "If true, this component will be unloaded." - [this actor destroyed-p]) + (o! this actor destroyed-p)) (defmethod attach ((this component) actor) "Attach this component to an actor." - (setf [this :slot actor] (make-weak-pointer (ensure-live actor))) - [this (parent-changed)]) - -(defmethod parent-deactivated ((this component) parent) - "Called when the component's actor is deactivated." - nil) - -(defmethod parent-activated ((this component) parent) - "Called when the component's actor is activated." - nil) + (setf (o! this :slot actor) (make-weak-pointer (ensure-live actor))) + (o! this (parent-changed))) (defmethod parent-changed ((this component)) "Called when the component's actor's parent is changed." nil) -(defmethod deactivate ((this component)) +(defmethod deactivate ((this component) &key origin) "Deactivate this component." - (setf [this :slot active-p] nil)) + (unless origin + (setf (o! this :slot active-p) nil))) -(defmethod activate ((this component)) +(defmethod activate ((this component) &key origin) "Activate this component." - (setf [this :slot active-p] t)) + (unless origin + (setf (o! this :slot active-p) t))) (defmethod resume ((this component)) "Initialize or restore this component's state." @@ -80,7 +74,7 @@ (defmethod start ((this component)) "Called before (update) the first time this component is processed." - (setf [this :slot started-p] t)) + (setf (o! this :slot started-p) t)) (defmethod update ((this component)) "Called every game tick while this component and its actor are active." diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp index bb45251..82c695c 100644 --- a/wh-engine/main.lisp +++ b/wh-engine/main.lisp @@ -36,7 +36,7 @@ (defun ensure-live (obj) "Ensure obj is live (non-destroyed)." - (when [obj destroyed-p] + (when (o! obj destroyed-p) (error "~S was used after it was destroyed" obj)) obj) @@ -96,20 +96,20 @@ (defun get-scene (scene-id) "Get a scene by its ID." - (find-if (lambda (scene) (eq [scene id] scene-id)) *world-scenes*)) + (find-if (lambda (scene) (eq (o! scene id) scene-id)) *world-scenes*)) (defun attach-actor-to-world (actor scene) "Properly attach actor and its descendents to scene, and initialize them." ;; attach actors to scene (apply-to-tree actor (lambda (a) - (setf [a :slot scene] nil) - [scene (add-actor a)])) + (setf (o! a :slot scene) nil) + (o! scene (add-actor a)))) ;; (resume) -> automatically resumes children - [actor (resume)] + (o! actor (resume)) ;; FIXME make (activate) call itself recursively on children (apply-to-tree actor (lambda (a) - (when [a tree-active-p] - [a (activate)]))) + (when (o! a tree-active-p) + (o! a (activate))))) ) (defvar *view-width* 384 @@ -136,51 +136,48 @@ (setf test-actor (make-instance 'actor :name "Actor")) - ;; [test-scene (add-actor test-actor)] + ;; (o! test-scene (add-actor test-actor)) (setf test-drawable (make-instance 'drawable-test)) - [test-actor (add-component test-drawable)] + (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)) - ;; [test-scene (add-actor test-actor-2)] + ;; (o! test-scene (add-actor test-actor-2)) - [test-actor-2 (add-component (make-instance 'drawable-test - :colour (vec4 0.0 1.0 0.0 1.0))) - ] + (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)) - ;; [test-scene (add-actor child-actor)] - [test-actor-2 (add-child child-actor)] + ;; (o! test-scene (add-actor child-actor)) + (o! test-actor-2 (add-child child-actor)) - [child-actor (add-component (make-instance 'drawable-test - :colour (vec4 0.0 1.0 1.0 1.0))) - ] + (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)) - ;; [test-scene (add-actor grandchild-actor)] - [child-actor (add-child grandchild-actor)] + ;; (o! test-scene (add-actor grandchild-actor)) + (o! child-actor (add-child grandchild-actor)) - [grandchild-actor (add-component (make-instance 'drawable-test - :colour (vec4 1.0 1.0 0.0 0.0))) - ] + (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")) - ;; [test-scene (add-actor camera-actor)] + ;; (o! test-scene (add-actor camera-actor)) (setf camera-view (make-instance 'view)) - [camera-actor (add-component camera-view)] + (o! camera-actor (add-component camera-view)) (attach-actor-to-world test-actor test-scene) (attach-actor-to-world test-actor-2 test-scene) @@ -202,9 +199,9 @@ +version+)) (sdl2:with-gl-context (gl-context win) (sdl2:gl-make-current win gl-context) - (let ((framebuf (car (gl:gen-framebuffers 1))) - (renderbuf (car (gl:gen-renderbuffers 1))) - (render-texture (car (gl:gen-textures 1))) + (let ((framebuf (gl:gen-framebuffer)) + (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)))) ;; set up framebuffer @@ -231,6 +228,8 @@ (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* @@ -247,7 +246,7 @@ (:idle () ;; update (loop for scene in *world-scenes* - do [scene (update)]) + do (o! scene (update))) ;; draw to render texture (gl:bind-framebuffer :framebuffer framebuf) (gl:viewport 0 0 *view-width* *view-height*) @@ -256,12 +255,12 @@ (let ((render-pass nil)) (loop for view-ptr in *world-views* for view = (ensure-live (weak-pointer-value view-ptr)) - when (and [view active-p] [view actor tree-active-p]) + when (and (o! view active-p) (o! view actor tree-active-p)) do (progn - (unless (eq [view render-pass] render-pass) - (setf render-pass [view render-pass]) + (unless (eq (o! view render-pass) render-pass) + (setf render-pass (o! view render-pass)) (gl:clear :depth-buffer)) - [view (render-view *world-drawables*)]))) + (o! view (render-view *world-drawables*))))) ;; now draw to window (gl:bind-framebuffer :framebuffer 0) diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp index 32139eb..4af7643 100644 --- a/wh-engine/package.lisp +++ b/wh-engine/package.lisp @@ -6,6 +6,7 @@ (:use common-lisp 3d-vectors 3d-matrices) (:import-from sb-ext weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value) + (:import-from objective-lisp O!) (:export ;; main.lisp +version+ ensure-version @@ -14,6 +15,7 @@ make-id fixed-id *running-scenes* add-scene remove-scene get-scene update-all-scenes + attach-actor-to-world *view-width* *view-height* *view-ppu* *pixel-scale* register-test-scene run @@ -42,7 +44,7 @@ get-component add-component add-child remove-child has-tag add-tag remove-tag - parent-deactivated parent-activated parent-changed + parent-changed deactivate activate resume suspend update @@ -59,7 +61,7 @@ scene destroyed-p ; methods attach - parent-deactivated parent-activated parent-changed + parent-changed deactivate activate resume suspend start update diff --git a/wh-engine/render/drawable.lisp b/wh-engine/render/drawable.lisp index 596db0b..e14445c 100644 --- a/wh-engine/render/drawable.lisp +++ b/wh-engine/render/drawable.lisp @@ -33,7 +33,7 @@ (cons (vec2 -0.5 -0.5) (vec2 0.5 0.5))) (defmethod draw ((this drawable-test) view) - (gl:color (vx4 [this colour]) (vy4 [this colour]) (vz4 [this colour]) (vw4 [this colour])) + (gl:color (vx4 (o! this colour)) (vy4 (o! this colour)) (vz4 (o! this colour)) (vw4 (o! this colour))) (gl:with-primitives :quads (gl:vertex -0.5 -0.5 0.0 1.0) (gl:vertex 0.5 -0.5 0.0 1.0) diff --git a/wh-engine/render/view.lisp b/wh-engine/render/view.lisp index f24ce06..de88d62 100644 --- a/wh-engine/render/view.lisp +++ b/wh-engine/render/view.lisp @@ -3,7 +3,7 @@ (defun sort-world-views () "Re-sort the *world-views* list by render pass." - (sort *world-views* #'< :key (lambda (v) [(deref-pointer v) 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." @@ -20,23 +20,79 @@ :accessor cull-p :type boolean :initarg :cull-p - :initform t)) + :initform t) + (framebuffer :documentation "The GL framebuffer this view renders to." + :reader framebuffer + :type (or fixnum null) + :initform nil) + (renderbuffer :documentation "The GL renderbuffer this view renders depth & stencil data to." + :reader renderbuffer + :type (or fixnum null) + :initform nil) + (render-texture :documentation "The GL render texture this view renders color data to." + :reader render-texture + :type (or fixnum null) + :initform nil)) (:documentation "Defines a view into the scene, and rendering settings for objects drawn by the view.")) (defmethod (setf render-pass) (new-val (this view)) "The render pass this view should be drawn in." - (setf [this :slot render-pass] new-val) + (setf (o! this :slot render-pass) new-val) (sort-world-views)) -(defmethod start :after ((this view)) +(defmethod resume :after ((this view)) + ;; create render texture & framebuffer + (unless (and (o! this render-texture) (gl:texture-resident-p (o! this render-texture)) + (o! this renderbuffer) (gl:is-renderbuffer (o! this renderbuffer)) + (o! this framebuffer) (gl:is-framebuffer (o! this framebuffer))) + ;; ensure the old ones are deleted if they exist + (when (o! this framebuffer) + (gl:delete-framebuffers (list (o! this framebuffer)))) + (when (o! this render-texture) + (gl:delete-texture (o! this render-texture))) + (when (o! this renderbuffer) + (gl:delete-renderbuffers (list (o! this renderbuffer)))) + ;; create render texture + (setf (o! this :slot render-texture) (gl:gen-texture)) + (gl:bind-texture :texture-2d (o! this 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 :linear) + (gl:tex-parameter :texture-2d :texture-mag-filter :linear) + (gl:bind-texture :texture-2d 0) + ;; create renderbuffer + (setf (o! this :slot renderbuffer) (gl:gen-renderbuffer)) + (gl:bind-renderbuffer :renderbuffer (o! this renderbuffer)) + (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*) + (gl:bind-renderbuffer 0) + ;; create framebuffer + (setf (o! this :slot framebuffer) (gl:gen-framebuffer)) + (gl:bind-framebuffer :framebuffer (o! this framebuffer)) + (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d (o! this render-texture) 0) + (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer (o! this renderbuffer)) + (gl:bind-framebuffer 0) + )) + +(defmethod activate :after ((this view) &key) ; Register (pushnew (make-weak-pointer this) *world-views*) (sort-world-views)) (defmethod destroy :before ((this view)) - (unless [this destroyed-p] - ; Unregister - (setf *world-views* (delete this *world-views* :key #'weak-pointer-value)))) + (unless (o! this destroyed-p) + ;; Unregister + (setf *world-views* (delete this *world-views* :key #'weak-pointer-value)) + ;; Destroy buffers + (when (o! this framebuffer) + (gl:delete-framebuffers (list (o! this framebuffer)))) + (when (o! this render-texture) + (gl:delete-texture (o! this render-texture))) + (when (o! this renderbuffer) + (gl:delete-renderbuffers (list (o! this renderbuffer)))) + )) (defmethod view-matrix ((this view)) "The world-to-view-space transformation matrix for this object." @@ -45,35 +101,35 @@ (m* (mat *view-ppu* 0 (/ *view-width* 2) 0 *view-ppu* (/ *view-height* 2) 0 0 1) - [this actor local-matrix])) + (o! this actor local-matrix))) (defmethod world-matrix ((this view)) "The view-to-world-space transformation matrix for this object." - (minv [this view-matrix])) + (minv (o! this view-matrix))) (defmethod view-point ((this view) point) "Transform point from world space to view space." (declare (type vec2 point)) - (vxy-trunc (m* [this view-matrix] (vxy1 point)))) + (vxy-trunc (m* (o! this view-matrix) (vxy1 point)))) (defmethod render-view ((this view) drawables) "Render everything in this view, given all drawables in the world." - (let ((view-matrix [this view-matrix])) + (let ((view-matrix (o! this view-matrix))) ;; Apply view matrix (gl:matrix-mode :modelview) (gl:load-transpose-matrix (opengl-matrix view-matrix)) (loop for drawable-ptr in drawables for drawable = (deref-pointer drawable-ptr) when (and drawable (ensure-live drawable)) - when (and [drawable active-p] [drawable actor tree-active-p] - (some (lambda (x) [drawable actor (has-tag x)]) [this render-mask])) - do [this (render-drawable drawable view-matrix)]) + when (and (o! drawable active-p) (o! drawable actor tree-active-p) + (some (lambda (x) (o! drawable actor (has-tag x))) (o! this render-mask))) + do (o! this (render-drawable drawable view-matrix))) )) (defun in-view-p (drawable drawable-matrix view-matrix view-box) "Determine if drawable is in the view defined by view-matrix and view-box." - (let ((drawable-culling-box [drawable culling-box]) + (let ((drawable-culling-box (o! drawable culling-box)) box-a box-b) (setf box-a (vxy-trunc (m* view-matrix (m* drawable-matrix (vxy1 (car drawable-culling-box)))))) @@ -86,11 +142,11 @@ (defmethod render-drawable ((this view) drawable view-matrix) "Render drawable with the precomputed view-matrix." - (let ((drawable-matrix [drawable actor world-matrix])) - (when (or (not [this cull-p]) (in-view-p drawable drawable-matrix view-matrix + (let ((drawable-matrix (o! drawable actor world-matrix))) + (when (or (not (o! this cull-p)) (in-view-p drawable drawable-matrix view-matrix (cons (vec2 0 0) (vec2 *view-width* *view-height*)))) (gl:push-matrix) - (gl:translate 0 0 [drawable actor z-layer]) + (gl:translate 0 0 (o! drawable actor z-layer)) (gl:mult-transpose-matrix (opengl-matrix drawable-matrix)) - [drawable (draw this)] + (o! drawable (draw this)) (gl:pop-matrix)))) diff --git a/wh-engine/scene.lisp b/wh-engine/scene.lisp index a2f0f0d..a156b09 100644 --- a/wh-engine/scene.lisp +++ b/wh-engine/scene.lisp @@ -27,59 +27,59 @@ (defmethod print-object ((this scene) stream) (print-unreadable-object (this stream :type t :identity t) - (prin1 [this :slot id] stream) + (prin1 (o! this :slot id) stream) (princ " ") - (prin1 [this :slot name] stream))) + (prin1 (o! this :slot name) stream))) (defmethod add-actor ((this scene) actor) "Add an actor to this scene." - (when [actor scene] - (error "~S is already in scene ~S" actor [actor scene])) - (push actor [this :slot actors]) - (setf [actor :slot scene] (make-weak-pointer this)) + (when (o! actor scene) + (error "~S is already in scene ~S" actor (o! actor scene))) + (push actor (o! this :slot actors)) + (setf (o! actor :slot scene) (make-weak-pointer this)) actor) (defmethod remove-actor ((this scene) actor) "Remove an actor from this scene." - (unless (eq [actor scene] this) + (unless (eq (o! actor scene) this) (error "~S is not in scene ~S" actor this)) - (setf [this :slot actors] (delete actor [this :slot actors] :count 1)) - (setf [actor :slot scene] nil) + (setf (o! this :slot actors) (delete actor (o! this :slot actors) :count 1)) + (setf (o! actor :slot scene) nil) actor) (defmethod get-actor ((this scene) actor-id) "Get the actor with the specified ID in this scene." - (find-if (lambda (actor) (eq [actor id] actor-id)) [this actors])) + (find-if (lambda (actor) (eq (o! actor id) actor-id)) (o! this actors))) (defmethod get-tagged-actors ((this scene) tags) "Get all actors tagged with the given set of tags." - (loop for actor in [this actors] - if (subsetp tags [actor tags]) + (loop for actor in (o! this actors) + if (subsetp tags (o! actor tags)) collect actor)) (defmethod update ((this scene)) "Update all actors in this scene." - (loop for actor in [this actors] - unless (or [actor destroyed-p] (not [actor tree-active-p])) - do [actor (update)])) + (loop for actor in (o! this actors) + unless (or (o! actor destroyed-p) (not (o! actor tree-active-p))) + do (o! actor (update)))) (defmethod destroy ((this scene)) "Mark this scene for unloading." - (unless [this destroyed-p] + (unless (o! this destroyed-p) ; We're dead, clean up actors - (loop for actor in [this actors] - do [actor (destroy)]) + (loop for actor in (o! this actors) + do (o! actor (destroy))) (remove-scene this)) - (setf [this :slot destroyed-p] t)) + (setf (o! this :slot destroyed-p) t)) (defmethod resume ((this scene)) "Initialize or restore this scene's state." ; Restore actors - (loop for actor in [this actors] - do [actor (resume)])) + (loop for actor in (o! this actors) + do (o! actor (resume)))) (defmethod suspend ((this scene)) "Prepare this scene for serialization." ; Suspend actors - (loop for actor in [this actors] - do [actor (suspend)])) + (loop for actor in (o! this actors) + do (o! actor (suspend)))) diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp index f58eb9e..99c08dc 100644 --- a/wh-engine/serialization.lisp +++ b/wh-engine/serialization.lisp @@ -25,19 +25,19 @@ (let ((target (weak-pointer-value ptr))) (etypecase target (scene - (make-id-ref :scene [target id])) + (make-id-ref :scene (o! target id))) (actor - (make-id-ref :scene (etypecase [target :slot scene] - (weak-pointer [target scene id]) - (id-ref (id-ref-scene [target :slot scene]))) - :actor [target id])) + (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 [target :slot actor] - (weak-pointer [target scene id]) - (id-ref (id-ref-scene [target :slot actor]))) - :actor (etypecase [target :slot actor] - (weak-pointer [target actor id]) - (id-ref (id-ref-actor [target :slot actor]))) + (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)))) ))) @@ -49,9 +49,9 @@ (unless scene (error "can't pointerize ~S (scene not found)" ref)) (if (id-ref-actor ref) - (if (setf actor [scene (get-actor (id-ref-actor ref))]) + (if (setf actor (o! scene (get-actor (id-ref-actor ref)))) (if (id-ref-component ref) - (if (setf component [actor (get-component (find-class (id-ref-component ref)))]) + (if (setf component (o! actor (get-component (find-class (id-ref-component ref))))) (make-weak-pointer component) (error "can't pointerize ~S (component not found)" ref)) (make-weak-pointer actor)) @@ -90,11 +90,11 @@ (make-load-form obj) (let ((sym (if nice-syms (typecase obj - (scene (gensym (format nil "S~a-G" [obj :slot id]))) - (actor (gensym (format nil "A~a-G" [obj :slot id]))) - (component (gensym (if (typep [obj :slot actor] 'id-ref) + (scene (gensym (format nil "S~a-G" (o! obj :slot id)))) + (actor (gensym (format nil "A~a-G" (o! obj :slot id)))) + (component (gensym (if (typep (o! obj :slot actor) 'id-ref) (format nil "C~a-~a-G" - (id-ref-actor [obj :slot actor]) (class-name (class-of obj))) + (id-ref-actor (o! obj :slot actor)) (class-name (class-of obj))) (format nil "C-~a-G" (class-name (class-of obj)))))) (t (gensym))) (gensym)))) @@ -213,18 +213,18 @@ (declare (type scene scene)) (declare (type boolean destroy-after prune nice-syms)) - [scene (suspend)] + (o! scene (suspend)) (prog1 (generate-load-forms scene :prune prune :nice-syms nice-syms) (if destroy-after - [scene (destroy)] - [scene (resume)]))) + (o! scene (destroy)) + (o! scene (resume))))) (defun collect-descendents (actor) "Recursively collect actor and all its descendents." (declare (type actor actor)) (cons actor - (loop for child-ptr in [actor children] + (loop for child-ptr in (o! actor children) nconc (collect-descendents (weak-pointer-value child-ptr))))) (defun dump-actors (actors &key (destroy-after t) (prune t) (nice-syms nil)) @@ -237,22 +237,22 @@ nconc (collect-descendents actor)))) ;; Suspend (loop for actor in actors - do [actor (suspend)]) + do (o! actor (suspend))) ;; Serialize (prog1 (loop for actor in all-actors collect (generate-load-forms actor :prune prune :nice-syms nice-syms)) ;; Resume/destroy (if destroy-after - (loop for actor in actors do [actor (destroy)]) - (loop for actor in actors do [actor (resume)]))) + (loop for actor in actors do (o! actor (destroy))) + (loop for actor in actors do (o! actor (resume))))) )) (defun load-resume-scene (scene-form) "Load and resume the scene saved in scene-form." (let ((scene (eval scene-form))) (add-scene scene) - [scene (resume)] + (o! scene (resume)) scene)) (defun load-resume-actors (actor-forms) @@ -260,5 +260,5 @@ (let ((actors (loop for actor-form in actor-forms collect (eval actor-form)))) (loop for actor in actors - do [actor (resume)] + do (o! actor (resume)) collect actor)))