floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement an entity-component system and a scene graph

Browse source 
Use entities and components to define objects in the game world
and represent the game scene as a graph
This commit is contained in:
Renaud Casenave-Péré 2015-12-27 17:05:18 +01:00
parent 6e3b3ae8a1
commit 8838362c26
10 changed files with 435 additions and 176 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
core/all.lisp
View file

@ -13,4 +13,5 @@
:stoe/core/modules
:stoe/core/jobs
:stoe/core/file
:stoe/core/resources))
:stoe/core/resources
:stoe/core/entity))

116
core/entity.lisp Normal file
View file

@ -0,0 +1,116 @@
#|
This file is a part of stoe project.
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#
(uiop:define-package :stoe/core/entity
(:use :cl :alexandria
:stoe/core/utils)
(:export #:entity #:object-id
#:component #:owner #:activep #:category
#:get-components #:get-first-component #:get-all-components
#:add-component #:remove-component
#:make-entity #:create-entity #:destroy-entity))
(in-package :stoe/core/entity)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *entity-array* (make-array 10 :adjustable t :fill-pointer 0))
(defvar *components-table-table* (make-hash-table)))
(let (available-ids)
(defun get-available-ids ()
available-ids)
(defun register-entity (entity)
(let ((available-id (pop available-ids)))
(unless available-id
(setf available-id (extend-array *entity-array*)))
(setf (aref *entity-array* available-id) entity)
(prog1
available-id
(setf available-ids (delete available-id available-ids)))))
(defun unregister-entity (entity)
(let ((id (object-id entity)))
(push id available-ids)
(if (= id (1- (fill-pointer *entity-array*)))
(let ((new-fill-pointer (loop for index = (1- id) then (decf index)
while (member index available-ids)
finally (return (1+ index)))))
(shrink-array *entity-array* new-fill-pointer)
(setf available-ids (delete-if (lambda (x) (>= x new-fill-pointer)) available-ids)))
(setf (aref *entity-array* id) nil))
(values))))
(defclass entity ()
((name :initarg :name :reader name)
(object-id :initform 0 :reader object-id))
(:documentation "Class for an entity comprised of a unique identifier."))
(defmethod initialize-instance :after ((entity entity) &key)
(with-slots (object-id) entity
(setf object-id (register-entity entity))))
(defclass component ()
((owner :initarg :owner :reader owner)
(activep :initarg :activep :initform t :accessor activep)
(category :initform :component :reader category :allocation :class)
(allow-multiple-p :initform t :reader allow-multiple-p :allocation :class))
(:documentation "Base class for a component linked to an entity, its owner."))
(defun push-component-table (category)
(setf (gethash category *components-table-table*) (make-hash-table)))
(defun get-components (entity category)
"Return a list of entity's components from category."
(let ((components-table (gethash category *components-table-table*)))
(unless (null components-table)
(safe-list (gethash (object-id entity) components-table)))))
(defun get-first-component (entity category)
"Return the first component of entity from category."
(let ((components-table (gethash category *components-table-table*)))
(unless (null components-table)
(safe-first (gethash (object-id entity) components-table)))))
(defun get-all-components (entity)
"Return a list of all entity's components."
(flatten (loop for components-table being the hash-value in *components-table-table*
collect (gethash (object-id entity) components-table))))
(defun add-component (entity component)
"Add a component to entity."
(let ((components-table (gethash (category component) *components-table-table*)))
(when (null components-table)
(setf components-table (push-component-table (category component))))
(if (allow-multiple-p component)
(push component (gethash (object-id entity) components-table))
(if (gethash (object-id entity) components-table)
(error "A component of the same type already exists for this entity.")
(setf (gethash (object-id entity) components-table) component)))))
(defun remove-component (entity component)
"Remove a component from entity."
(let ((components-table (gethash (category component) *components-table-table*)))
(unless (null components-table)
(let ((place (gethash (object-id entity) components-table)))
(if (allow-multiple-p component)
(setf place (delete component place))
(remhash place components-table))))))
(defmethod initialize-instance :after ((comp component) &key owner)
(add-component owner comp))
(defun make-entity (name)
(make-instance 'entity :name name))
(defmacro create-entity (name &body component-specs)
(with-gensyms (entity)
`(ret ,entity (make-entity ,name)
,@(loop for specs in component-specs
collect (let* ((spec (safe-list specs)))
`(make-instance ',(first spec) ,@(append `(:owner ,entity) (rest spec))))))))
(defun destroy-entity (entity)
(loop for comp in (get-all-components entity)
do (remove-component entity comp))
(unregister-entity entity))

9
engine/all.lisp
View file

@ -8,10 +8,13 @@
(:use-reexport
:stoe/engine/gl-utils
:stoe/engine/mesh
:stoe/engine/scene-graph
:stoe/engine/camera
:stoe/engine/scene
#+stoe-foreign-assets
:stoe/engine/import
:stoe/engine/input
:stoe/engine/viewport
:stoe/engine/shaders
:stoe/engine/render))
:stoe/engine/render
:stoe/engine/model
#+stoe-foreign-assets
:stoe/engine/import))

36
engine/camera.lisp Normal file
View file

@ -0,0 +1,36 @@
#|
This file is a part of stoe project.
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#
(uiop:define-package :stoe/engine/camera
(:use :cl :maths
:stoe/core/entity
:stoe/engine/scene-graph)
(:export #:camera #:projection #:view
#:update-view))
(in-package :stoe/engine/camera)
(defclass camera (component)
((fovy :initarg :fovy)
(aspect :initarg :aspect)
(near :initarg :near)
(far :initarg :far)
(projection :initarg :projection :accessor projection)
(view :accessor view)
(category :initform :camera :allocation :class))
(:documentation "Component for a camera representing a view of the game world."))
(defmethod initialize-instance :after ((camera camera) &key owner fovy aspect near far)
(with-slots (projection) camera
(setf projection (mperspective fovy aspect near far)))
(when owner
(update-view camera)))
(defun update-view (camera)
"Compute the world-to-view matrix from the position and the direction of the camera"
(let* ((node (get-first-component (owner camera) :graph-node))
(position (position-of node))
(direction (direction-of node))
(view (m* (transpose (quat-to-mat4 direction)) (mtranslate (v- position)))))
(setf (view camera) view)))

73
engine/import.lisp
View file

@ -5,9 +5,13 @@
(uiop:define-package :stoe/engine/import
(:use :cl :maths
:stoe/core/utils
:stoe/core/jobs
:stoe/core/resources
:stoe/engine/gl-utils
:stoe/engine/mesh
:stoe/engine/scene)
:stoe/engine/scene
:stoe/engine/model)
(:export #:import-graphic-assets))
(in-package :stoe/engine/import)
@ -45,19 +49,23 @@
mat))
(defun import-nodes (node)
(labels ((rec (node parent)
(let ((len (array-total-size (classimp:children node))))
(loop for i below len
for child = (aref (classimp:children node) i)
do (let ((scene-node (make-scene-node (classimp:name child) parent
(import-transform (classimp:transform child))
(coerce (classimp:meshes child) 'list))))
(rec child scene-node))))))
(when node
(let ((root-node (make-scene-node (classimp:name node) nil
(import-transform (classimp:transform node)))))
(rec node root-node)
root-node))))
(let ((len (length (classimp:children node)))
model-node)
(loop for i below len
for child = (aref (classimp:children node) i)
do (let ((child-node (import-nodes child)))
(when child-node
(unless model-node
(setf model-node
(make-model-node
(classimp:name node) (coerce (classimp:meshes node) 'list)
nil (import-transform (classimp:transform node)))))
(attach-node child-node model-node))))
(when (and (null model-node) (> (length (classimp:meshes node)) 0))
(setf model-node (make-model-node
(classimp:name node) (coerce (classimp:meshes node) 'list)
nil (import-transform (classimp:transform node)))))
model-node))
(defun import-modes (mesh)
(when (classimp:mesh-has-multiple-primitive-types mesh)
@ -68,19 +76,24 @@
((classimp:mesh-has-triangles mesh) :triangles)
((classimp:mesh-has-polygons mesh) (error "Polygons mode is not supported."))))
(defun import-graphic-assets (filename)
(let ((ai-scene (classimp:import-into-lisp filename)))
(make-instance 'scene
:meshes
(coerce (loop for i below (array-total-size (classimp:meshes ai-scene))
for mesh = (aref (classimp:meshes ai-scene) i)
collect (make-mesh
(remove nil
(list (import-stream (classimp:vertices mesh)
:position)
(when (> (length (classimp:colors mesh)) 0)
(import-stream (aref (classimp:colors mesh) 0)
:color))))
(import-faces (classimp:faces mesh) (import-modes mesh))))
'vector)
:root-node (import-nodes (classimp:root-node ai-scene)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun import-graphic-assets (path)
(async-job (path)
(classimp:import-into-lisp path))))
(defrestype "dae" model-resource
((:load (path (ai-scene (import-graphic-assets path)) res)
(with-slots (root-node meshes) res
(setf meshes
(coerce (loop for i below (array-total-size (classimp:meshes ai-scene))
for mesh = (aref (classimp:meshes ai-scene) i)
collect (make-mesh
(remove nil
(list (import-stream (classimp:vertices mesh)
:position)
(when (> (length (classimp:colors mesh)) 0)
(import-stream (aref (classimp:colors mesh) 0)
:color))))
(import-faces (classimp:faces mesh) (import-modes mesh))))
'vector)
root-node (import-nodes (classimp:root-node ai-scene)))))))

68
engine/mesh.lisp
View file

@ -12,16 +12,20 @@
#:vertex-stream #:attrib
#:index-stream #:mode
#:make-stream-array #:make-vertex-stream #:make-index-stream #:bsize
#:mesh-initialize
#:render-mesh))
(in-package :stoe/engine/mesh)
(defclass mesh ()
((streams :initarg :streams :accessor vertex-streams)
(faces :initarg :faces :accessor faces))
((streams :initarg :streams :reader vertex-streams)
(faces :initarg :faces :reader faces)
(material :initarg :material :reader material)
(vertex-buffers :initform nil :accessor vertex-buffers)
(index-buffer :initform nil :accessor index-buffer))
(:documentation "Class for a single mesh."))
(defun make-mesh (&optional streams faces)
(make-instance 'mesh :streams streams :faces faces))
(make-instance 'mesh :streams streams :faces faces :material nil))
(defclass stream-array ()
((array :initarg :array :reader raw-data)
@ -30,7 +34,7 @@
(defclass vertex-stream (stream-array)
((attrib :initarg :attrib :reader attrib)
(stride :initarg :stride)))
(stride :initarg :stride :reader stride)))
(defclass index-stream (stream-array)
((mode :initarg :mode :reader mode)))
@ -51,39 +55,47 @@
(defmethod bsize ((stream stream-array))
(* (ctype-size (ctype stream)) (length (raw-data stream))))
(defun render-mesh (mesh program)
(let ((buffer-objects nil))
(defun mesh-initialize (mesh)
(let ((vertex-buffers (gl:gen-buffers (length (vertex-streams mesh))))
(index-buffer (gl:gen-buffer)))
(loop for stream in (vertex-streams mesh)
with offset = 0
for buffer-object in vertex-buffers
do (let* ((ctype (ctype stream)) (size (size stream)) (bsize (bsize stream))
(data (raw-data stream)) (attrib (attrib stream))
(data (raw-data stream))
(ptr (foreign-alloc ctype :count size)))
;; create the data for opengl
(dotimes (i (length data))
(setf (mem-aref ptr ctype i) (aref data i)))
(let ((buffer-object (gl:gen-buffer)))
(push buffer-object buffer-objects)
(gl:bind-buffer :array-buffer buffer-object)
(%gl:buffer-data :array-buffer bsize ptr :static-draw)
;; use it
(let ((loc (get-location program attrib)))
(gl-assert (gl:enable-vertex-attrib-array loc)
(gl:vertex-attrib-pointer loc 3 ctype :false 0 offset))
(incf offset bsize)
(foreign-free ptr)))))
(gl:bind-buffer :array-buffer buffer-object)
(%gl:buffer-data :array-buffer bsize ptr :static-draw)
(foreign-free ptr)))
(gl:bind-buffer :array-buffer 0)
(let* ((faces (faces mesh)) (data (raw-data faces))
(size (size faces)) (bsize (bsize faces))
(index-object (gl:gen-buffer))
(ptr (foreign-alloc (ctype faces) :initial-contents data :count size)))
(push index-object buffer-objects)
(gl:bind-buffer :element-array-buffer index-object)
(gl:bind-buffer :element-array-buffer index-buffer)
(%gl:buffer-data :element-array-buffer bsize ptr :static-draw)
(foreign-free ptr)
(gl-assert (%gl:draw-elements (mode faces) bsize (ctype-to-gltype (ctype faces)) 0)))
;; cleanup data
(loop for stream in (vertex-streams mesh)
do (let ((loc (get-location program (attrib stream))))
(gl:disable-vertex-attrib-array loc)))
(gl:delete-buffers buffer-objects)
(gl:bind-buffer :element-array-buffer 0))
(setf (vertex-buffers mesh) vertex-buffers
(index-buffer mesh) index-buffer)))
(defun render-mesh (mesh program)
(with-accessors ((vertex-buffers vertex-buffers) (streams vertex-streams)
(index-buffer index-buffer) (faces faces)) mesh
(loop for i below (length vertex-buffers)
for vertex in vertex-buffers
for stream in streams
with offset = 0
do (let* ((ctype (ctype stream)) (attrib (attrib stream))
(bsize (bsize stream)) (stride (stride stream))
(loc (get-location program attrib)))
(gl:bind-buffer :array-buffer vertex)
(gl-assert (gl:enable-vertex-attrib-array loc)
(gl:vertex-attrib-pointer loc stride ctype
:false 0 offset))
(incf offset bsize)))
(gl:bind-buffer :element-array-buffer index-buffer)
(gl-assert (%gl:draw-elements (mode faces) (bsize faces)
(ctype-to-gltype (ctype faces)) 0))
(gl:bind-buffer :element-array-buffer 0)
(gl:bind-buffer :array-buffer 0)))

76
engine/model.lisp Normal file
View file

@ -0,0 +1,76 @@
#|
This file is a part of stoe project.
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#
(uiop:define-package :stoe/engine/model
(:use :cl :maths
:stoe/core/utils
:stoe/core/entity
:stoe/core/resources
:stoe/engine/scene-graph
:stoe/engine/mesh
:stoe/engine/scene
:stoe/engine/render)
(:export #:model-node #:mesh-indexes #:make-model-node
#:model-resource #:root-node #:meshes #:meshref
#:mesh-component #:model #:make-mesh-component
#:create-model))
(in-package :stoe/engine/model)
(defclass model-node (node)
((name :initarg :name :accessor name)
(mesh-indexes :initarg :mesh-indexes :accessor mesh-indexes)
(transform :initarg :transform :reader transform :type float44)))
(defun make-model-node (name mesh-indexes &optional parent (transform (mat-id 4 'single-float)))
(make-instance 'model-node :parent parent :name name :mesh-indexes mesh-indexes :transform transform))
(defclass model-resource (shared-resource)
((root-node :initarg :root-node :accessor root-node :type model-node)
(meshes :initarg :meshes :accessor meshes))
(:documentation "Resource class containing the actual model data."))
(defmethod root-node ((res resource-proxy))
(with-slots (resource) res
(when (tg:weak-pointer-value resource)
(root-node (tg:weak-pointer-value resource)))))
(defmethod meshes ((res resource-proxy))
(with-slots (resource) res
(when (tg:weak-pointer-value resource)
(meshes (tg:weak-pointer-value resource)))))
(defun meshref (model-proxy subscript)
(aref (meshes model-proxy) subscript))
(defmethod resource-initialize ((res model-resource))
(with-slots (meshes) res
(on-render-thread (meshes)
(loop for mesh across meshes
do (mesh-initialize mesh)))))
(defclass mesh-component (graph-node)
((model :initarg :model :reader model)
(model-node :initarg :model-node :reader model-node :type model-node)
(category :initform :mesh :reader category :allocation :class))
(:documentation "A graph node component that contains a single mesh."))
(defun make-mesh-component (model model-node)
(make-instance 'mesh-component :model model :model-node model-node))
(defun create-model (name path &optional (parent-entity (current-scene (world))))
"Create a model from a resource file and attach it to the parent entity or root."
(ret entity (create-entity name
(scene-node :parent (get-first-component parent-entity :graph-node)))
(with-resource (path model)
(let ((scene-node (get-first-component entity :graph-node)))
(labels ((clone-mesh (node parent)
(setf parent (make-instance 'mesh-component :owner entity :parent parent
:transform (transform node) :model model :model-node node))
(mapc (lambda (child) (clone-mesh child parent)) (children node))))
(mapc (lambda (child) (clone-mesh child scene-node)) (children (root-node model))))))))
(defmethod render ((mesh mesh-component))
(loop for mesh-idx in (mesh-indexes (model-node mesh))
do (render-single-mesh (meshref (model mesh) mesh-idx) (transform mesh))))

32
engine/render.lisp
View file

@ -11,11 +11,15 @@
:stoe/core/modules
:stoe/core/thread
:stoe/core/jobs
:stoe/core/entity
:stoe/engine/gl-utils
:stoe/engine/mesh
:stoe/engine/viewport
:stoe/engine/scene-graph
:stoe/engine/camera
:stoe/engine/scene)
(:export #:on-render-thread))
(:export #:on-render-thread
#:render #:render-single-mesh))
(in-package :stoe/engine/render)
(defclass render-thread (specialized-thread)
@ -57,24 +61,26 @@ Destroy the opengl context and the related resources."
(defun render-single-mesh (mesh transform)
(using-program (program 'simple-shader)
(with-locations (model-to-camera camera-to-clip) program
(let ((mtc (m* (view (get-current-camera)) transform))
(ctc (projection (get-current-camera))))
(let* ((camera (get-first-component (main-camera (world)) :camera))
(mtc (m* (view camera) transform))
(ctc (projection camera)))
(gl:uniform-matrix model-to-camera 4 (vector (raw-data mtc)) nil)
(gl:uniform-matrix camera-to-clip 4 (vector (raw-data ctc)) nil)))
(render-mesh mesh program)))
(defun render-scene-node (node scene)
(loop for mesh-idx in (meshes node)
do (render-single-mesh (aref (meshes scene) mesh-idx) (transform node)))
(loop for child in (children node)
do (render-scene-node child scene)))
(defgeneric render (node))
(defmethod render ((node graph-node)))
(defmethod render :after ((node graph-node))
(mapc #'render (children node)))
(defun render-world (world)
(unless (null world)
(with-lock-held ((scene-lock world))
(with-accessors ((scene world-scene)) world
(unless (null scene)
(render-scene-node (root-node scene) scene))))))
(locking-scene
(let ((root-node (get-first-component (current-scene (world)) :graph-node)))
(unless (null root-node)
(render root-node))))))
(defmethod thread-initialize ((thread render-thread))
(format t "Initialize ~a~%" (name thread))
@ -96,7 +102,7 @@ Destroy the opengl context and the related resources."
do (progn
(format t "Thread ~a: Running job ~a~%" (name thread) (id job))
(job-run job thread)))
(render-world (get-world)))
(render-world (world)))
(update-clock clock)
(compute-fps (clock-delta clock))))))

57
engine/scene-graph.lisp Normal file
View file

@ -0,0 +1,57 @@
#|
This file is a part of stoe project.
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#
(uiop:define-package :stoe/engine/scene-graph
(:use :cl :maths
:stoe/core/utils
:stoe/core/entity)
(:export #:graph-node #:transform
#:scene-node
#:position #:position-of
#:direction #:direction-of
#:scale #:scale-of
#:move #:rotate #:scale))
(in-package :stoe/engine/scene-graph)
(defclass graph-node (component node)
((transform :initarg :transform :reader transform :type float44)
(category :initform :graph-node :allocation :class))
(:documentation "Node in the scene graph."))
(defclass scene-node (graph-node)
((position :initarg :position :initform (vec 0.0 0.0 0.0) :accessor position-of :type float3)
(direction :initarg :direction :initform (quat) :accessor direction-of :type quaternion)
(scale :initarg :scale :initform (vec 1.0 1.0 1.0) :accessor scale-of :type float3))
(:documentation "Node of a scene graph.
position, directon and scale will be combined to define a transform matrix to place the node in the scene."))
(defmethod initialize-instance :after ((node scene-node) &key)
(update-transform node))
(defun graph-root (node)
"Return the root of the tree which contains node."
(if (parent node)
(graph-root (parent node))
node))
(defun update-transform (node)
(with-slots (transform) node
(setf transform (m* (mtranslate (position-of node))
(mscale (scale-of node))
(quat-to-mat4 (direction-of node))))))
(defun move (node &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-slots (position direction) node
(setf position (v+ position (m* (quat-to-mat3 direction) (vec dx dy dz))))))
(defun rotate (node &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-slots (direction) node
(setf direction (q* (quat (vec 0.0 1.0 0.0) (deg-to-rad dx))
(quat (vec 1.0 0.0 0.0) (deg-to-rad dy))
(quat (vec 0.0 0.0 1.0) (deg-to-rad dz)) direction))))
(defun scale (node &key (dx 1.0) (dy 1.0) (dz 1.0))
(with-slots (scale) node
(setf scale (vec (* dx (x scale)) (* dy (y scale)) (* dz (z scale))))))

141
engine/scene.lisp
View file

@ -6,118 +6,57 @@
(uiop:define-package :stoe/engine/scene
(:use :cl :maths
:stoe/core/utils
:stoe/core/entity
:stoe/core/thread
:stoe/engine/scene-graph
:stoe/engine/gl-utils
:stoe/engine/viewport
:stoe/engine/mesh)
(:export #:world #:world-scene #:world-camera #:scene-lock #:scenes #:world-initialize
#:get-world #:get-current-scene #:get-current-camera
#:scene-node #:transform #:children #:meshes #:make-scene-node #:attach-child
#:scene #:root-node #:make-scene
#:object #:pos #:dir #:make-object #:update-transform #:move #:rotate
#:camera #:projection #:view #:update-view #:make-camera))
:stoe/engine/mesh
:stoe/engine/camera)
(:export #:world #:current-scene #:main-camera
#:create-world #:destroy-world #:locking-scene))
(in-package :stoe/engine/scene)
(defvar *world* nil)
(defclass world ()
((current-scene :initform nil :accessor world-scene)
(current-camera :initform nil :accessor world-camera)
(defclass world (entity)
((current-scene :initform nil :reader current-scene)
(main-camera :initform nil :reader main-camera)
(lock :initform (make-lock "scene-lock") :accessor scene-lock)
(scenes :initform nil :accessor scenes)))
(scenes :initform nil :reader scenes)
(cameras :initform nil :reader cameras))
(:documentation "Special entity containing world's info"))
(defun make-world () (make-instance 'world))
(defun world-initialize () (setf *world* (make-world)))
(defun get-world () *world*)
(defun get-current-scene () (world-scene *world*))
(defun get-current-camera () (world-camera *world*))
(defun world () *world*)
(defclass scene-node ()
((name :initarg :name :accessor name)
(parent :initform nil :accessor parent)
(transform :initarg :transform :accessor transform)
(children :initarg :children :initform nil :accessor children)
(meshes :initarg :meshes :accessor meshes))
(:documentation "Base class for a node in the scene graph."))
(defun create-world ()
(when *world*
(error "World already exists."))
(let ((world (make-instance 'world :name "World")))
(with-slots (current-scene main-camera scenes cameras) world
(push (make-scene "Scene") scenes)
(setf current-scene (first scenes))
(push (make-camera "Camera" current-scene) cameras)
(setf main-camera (first cameras)))
(setf *world* world)))
(defun make-scene-node (name &optional parent transform meshes)
(let ((node (make-instance 'scene-node :name name :transform transform :meshes meshes)))
(when parent
(attach-child node parent))
node))
(defun destroy-world ()
(when *world*
(with-slots (scenes cameras) *world*
(mapc #'destroy-entity scenes)
(mapc #'destroy-entity cameras))
(destroy-entity *world*)
(setf *world* nil)))
(defun attach-child (node parent)
(with-slots ((node-parent parent)) node
(when parent
(with-slots (children) parent
(setf children (append children (list node)))
(setf node-parent parent))))
node)
(defmacro locking-scene (&body body)
`(with-lock-held ((scene-lock (world)))
,@body))
(defun detach-child (node)
(with-slots (node-parent) node
(when node-parent
(with-slots (children) node-parent
(delete node children)))))
(defun make-scene (name)
(create-entity name scene-node))
(defclass scene ()
((root-node :initarg :root-node :accessor root-node)
(cameras :initarg :cameras :accessor cameras)
(meshes :initarg :meshes :accessor meshes))
(:documentation "Class for the current scene."))
(defun make-scene ()
(make-instance 'scene))
(defclass object (scene-node)
((position :initarg :pos :accessor pos :type 'float3)
(direction :initarg :dir :accessor dir :type 'quaternion))
(:documentation "Base class for all objects existing in the game world."))
(defun make-object (&key (pos (vec 0.0 0.0 0.0)) (dir (quat (vec 0.0 0.0 1.0) 0.0)))
(make-instance 'object :pos pos :dir dir))
(defun update-transform (object)
(setf (transform object) (m* (transform (parent object))
(mtranslate (pos object))
(quat-to-mat4 (dir object)))))
(defgeneric move (object &key dx dy dz)
(:documentation "Move object along the x, y and z axis"))
(defmethod move ((object object) &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-accessors ((pos pos) (dir dir)) object
(setf pos (v+ pos (m* (quat-to-mat3 dir)(vec dx dy dz))))))
(defgeneric rotate (object &key dx dy dz)
(:documentation "Rotate object along the x, y and z axis"))
(defmethod rotate ((object object) &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-accessors ((dir dir)) object
(setf dir (q* (quat (vec 0.0 1.0 0.0) (deg-to-rad dx))
(quat (vec 1.0 0.0 0.0) (deg-to-rad dy))
(quat (vec 0.0 0.0 1.0) (deg-to-rad dz)) dir))))
(defclass camera (object)
((fovy :initarg :fovy)
(aspect :initarg :aspect)
(near :initarg :near)
(far :initarg :far)
(projection :initarg :projection :accessor projection)
(view :accessor view))
(:documentation "Base class for a camera representing a view of the game world."))
(defun update-view (camera)
"Compute the world to view matrix from the position and the direction of CAMERA."
(when (need-resize-p)
(with-slots (fovy aspect near far) camera
(setf aspect (/ (viewport-width) (viewport-height)))
(setf (projection camera) (mperspective fovy aspect near far))))
(with-accessors ((pos pos) (dir dir) (view view)) camera
(setf view (m* (transpose (quat-to-mat4 dir)) (mtranslate (v- pos))))))
(defun make-camera (fovy aspect near far)
(let ((camera (make-instance 'camera :pos (vec 0.0 0.0 2.0)
:dir (quat (vec 0.0 0.0 1.0) 0.0)
:fovy fovy :aspect aspect :near near :far far
:projection (mperspective fovy aspect near far))))
(update-view camera)
camera))
(defun make-camera (name scene)
(create-entity name
(scene-node :parent (get-first-component scene :graph-node)
:position (vec 0.0 0.0 2.0) :direction (quat (vec 0.0 0.0 1.0) 0.0))
(camera :fovy 90 :aspect (/ 16 9) :near 1.0 :far 1000.0)))