66 lines
2.7 KiB
Common Lisp
66 lines
2.7 KiB
Common Lisp
#|
|
|
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-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)
|
|
|
|
(defcomponent graph-node-component (node)
|
|
((transform :initarg :transform :reader transform :type float44))
|
|
(:documentation "Node in the scene graph."))
|
|
|
|
(defmethod attach-node ((node node) (parent entity))
|
|
(with-components (graph-node-component) parent
|
|
(attach-node node graph-node-component)))
|
|
|
|
(defun update-transform (node position direction scale)
|
|
(with-slots (transform) node
|
|
(setf transform (m* (mtranslate position)
|
|
(mscale scale)
|
|
(quat-to-mat4 direction)))))
|
|
|
|
(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)))
|
|
|
|
(defmethod print-object ((obj scene-object-component) stream)
|
|
(with-accessors ((pos position-of) (dir direction-of) (scale scale-of)) obj
|
|
(print-unreadable-object (obj stream :type t)
|
|
(format stream "~@<~:_position = ~a ~:_direction = ~a ~:_scale = ~a~:>"
|
|
pos dir 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 (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 (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))))))
|