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

Use new entity API

Browse source
This commit is contained in:
Renaud Casenave-Péré 2016-04-09 13:02:33 +02:00
parent fe1d32b079
commit faae6741be
6 changed files with 104 additions and 98 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
core/entity.lisp
View file

@ -179,7 +179,8 @@ class OPTIONS are supported together with the option :NEEDS used to define the d
(comp-deps (component-dependencies (safe-first comp))))
(when comp
(loop for dep in comp-deps
do (unless (or (member dep processing-specs) (member dep all-deps))
do (unless (or (member dep processing-specs :key #'safe-first)
(member dep all-deps :key #'safe-first))
(process-deps (cons (or (first (member dep specs :key #'safe-first)) dep) processing-specs)
(delete dep specs :test (lambda (dep spec) (eql dep (first spec)))))))
(push comp all-deps)))

25
engine/camera.lisp
View file

@ -7,30 +7,27 @@
(:use :cl :maths
:stoe/core/entity
:stoe/engine/scene-graph)
(:export #:camera #:projection #:view
(:export #:camera-component #:projection #:view
#:update-view))
(in-package :stoe/engine/camera)
(defclass camera (component)
(defcomponent 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))
(projection :initarg :projection :reader projection)
(view :accessor view))
(:needs scene-object-component)
(:documentation "Component for a camera representing a view of the game world."))
(defmethod initialize-instance :after ((camera camera) &key owner fovy aspect near far)
(defmethod initialize-instance :after ((camera camera-component) &key owner fovy aspect near far)
(with-slots (projection) camera
(setf projection (mperspective fovy aspect near far)))
(when owner
(update-view camera)))
(with-components (scene-object-component) owner
(with-slots (position direction) scene-object-component
(update-view camera position direction))))
(defun update-view (camera)
(defun update-view (camera position direction)
"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)))
(setf (view camera) (m* (transpose (quat-to-mat4 direction)) (mtranslate (v- position)))))

17
engine/model.lisp
View file

@ -50,26 +50,23 @@
(loop for mesh across meshes
do (mesh-initialize mesh)))))
(defclass mesh-component (graph-node)
(defcomponent mesh-component (graph-node-component)
((model :initarg :model :reader model)
(model-node :initarg :model-node :reader model-node :type model-node)
(category :initform :mesh :reader category :allocation :class))
(model-node :initarg :model-node :reader model-node :type model-node))
(:needs graph-node-component)
(: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))))
(defun create-model (name path &optional (parent-entity (current-scene)))
"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)))
(graph-node-component :parent parent-entity))
(with-resource (path model)
(let ((scene-node (get-first-component entity :graph-node)))
(with-components ((node graph-node-component)) entity
(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))))))))
(mapc (lambda (child) (clone-mesh child node)) (children (root-node model))))))))
(defmethod render ((mesh mesh-component))
(loop for mesh-idx in (mesh-indexes (model-node mesh))

19
engine/render.lisp
View file

@ -61,26 +61,25 @@ 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* ((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)))
(with-components (camera-component) (main-camera (world))
(let ((mtc (m* (view camera-component) transform))
(ctc (projection camera-component)))
(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)))
(defgeneric render (node))
(defmethod render ((node graph-node)))
(defmethod render ((node graph-node-component)))
(defmethod render :after ((node graph-node))
(defmethod render :after ((node graph-node-component))
(mapc #'render (children node)))
(defun render-world (world)
(unless (null world)
(locking-scene
(let ((root-node (get-first-component (current-scene (world)) :graph-node)))
(unless (null root-node)
(render root-node))))))
(with-components ((root graph-node-component)) (current-scene)
(render root)))))
(defmethod thread-initialize ((thread render-thread))
(format t "Initialize ~a~%" (name thread))

63
engine/scene-graph.lisp
View file

@ -7,51 +7,54 @@
(:use :cl :maths
:stoe/core/utils
:stoe/core/entity)
(:export #:graph-node #:transform
#:scene-node
(:export #:graph-node-component #:transform #:update-transform
#:scene-object-component
#: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))
(defcomponent graph-node-component (node)
((transform :initarg :transform :reader transform :type float44))
(: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 attach-node ((node node) (parent entity))
(with-components (graph-node-component) parent
(attach-node node graph-node-component)))
(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)
(defun update-transform (node position direction scale)
(with-slots (transform) node
(setf transform (m* (mtranslate (position-of node))
(mscale (scale-of node))
(quat-to-mat4 (direction-of node))))))
(setf transform (m* (mtranslate position)
(mscale scale)
(quat-to-mat4 direction)))))
(defun move (node &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-slots (position direction) node
(defcomponent scene-object-component ()
((position :initarg :position :accessor position-of :type float3)
(direction :initarg :direction :accessor direction-of :type quaternion)
(scale :initarg :scale :accessor scale-of :type float3))
(:needs graph-node-component)
(:default-initargs
:position (vec 0.0 0.0 0.0)
:direction (quat)
:scale (vec 1.0 1.0 1.0))
(:documentation "Object in a scene."))
(defmethod initialize-instance :after ((obj scene-object-component)
&key owner position direction scale)
(with-components ((node graph-node-component)) owner
(update-transform node position direction scale)))
(defun move (obj &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-slots (position direction) obj
(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
(defun rotate (obj &key (dx 0.0) (dy 0.0) (dz 0.0))
(with-slots (direction) obj
(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
(defun scale (obj &key (dx 1.0) (dy 1.0) (dz 1.0))
(with-slots (scale) obj
(setf scale (vec (* dx (x scale)) (* dy (y scale)) (* dz (z scale))))))

75
engine/scene.lisp
View file

@ -8,55 +8,64 @@
:stoe/core/utils
:stoe/core/entity
:stoe/core/thread
:stoe/engine/scene-graph
:stoe/engine/gl-utils
:stoe/engine/viewport
:stoe/engine/mesh
:stoe/engine/scene-graph
:stoe/engine/camera)
(:export #:world #:current-scene #:main-camera
(:export #:world #:world-component #:current-scene #:main-camera
#:create-world #:destroy-world #:locking-scene))
(in-package :stoe/engine/scene)
(defvar *world* nil)
(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 :reader scenes)
(cameras :initform nil :reader cameras))
(:documentation "Special entity containing world's info"))
(defun world () *world*)
(defun create-world ()
(defcomponent world-component ()
((lock :initform (make-lock "scene-lock") :accessor scene-lock)
(scenes :initform nil :reader scenes)
(cameras :initform nil :reader cameras))
(:documentation "Component containing world's info."))
(defun current-scene (&optional (world (world)))
(with-components (world-component) world
(first (scenes world-component))))
(defun main-camera (&optional (world (world)))
(with-components (world-component) world
(first (cameras world-component))))
(defmethod initialize-instance :after ((world world-component) &key scene camera)
(with-slots (scenes cameras) world
(when scene
(push scene scenes))
(when camera
(push camera cameras))))
(defun make-scene (name)
(create-entity name graph-node-component))
(defun make-camera (name scene)
(create-entity name
(graph-node-component :parent scene)
(scene-object-component :position (vec 0.0 0.0 2.0))
(camera-component :fovy 90 :aspect (/ 16 9) :near 1.0 :far 1000.0)))
(defun create-world (name)
(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)))
(let* ((scene (make-scene "Default Scene"))
(camera (make-camera "Default Camera" scene)))
(setf *world* (create-entity name
(world-component :scene scene :camera camera)))))
(defun destroy-world ()
(when *world*
(with-slots (scenes cameras) *world*
(mapc #'destroy-entity scenes)
(mapc #'destroy-entity cameras))
(with-components (world-component) *world*
(with-slots (scenes cameras) world-component
(mapc #'destroy-entity scenes)
(mapc #'destroy-entity cameras)))
(destroy-entity *world*)
(setf *world* nil)))
(defmacro locking-scene (&body body)
`(with-lock-held ((scene-lock (world)))
`(with-lock-held ((scene-lock (component (world) 'world-component)))
,@body))
(defun make-scene (name)
(create-entity name scene-node))
(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)))