From 74d2cdc890441726153f0548842566e738df1934 Mon Sep 17 00:00:00 2001 From: ~keith Date: Thu, 25 Nov 2021 22:28:50 +0000 Subject: [PATCH] Engine base somewhat functional --- .gitignore | 4 + README.md | 7 +- run.lisp | 7 + wh-engine.asd | 19 ++ wh-engine/actor.lisp | 317 +++++++++++++++++++++++++++++++++ wh-engine/component.lisp | 67 +++++++ wh-engine/main.lisp | 197 ++++++++++++++++++++ wh-engine/package.lisp | 82 +++++++++ wh-engine/render/drawable.lisp | 42 +++++ wh-engine/render/view.lisp | 96 ++++++++++ wh-engine/scene.lisp | 70 ++++++++ 11 files changed, 907 insertions(+), 1 deletion(-) create mode 100644 run.lisp create mode 100644 wh-engine.asd create mode 100644 wh-engine/actor.lisp create mode 100644 wh-engine/component.lisp create mode 100644 wh-engine/main.lisp create mode 100644 wh-engine/package.lisp create mode 100644 wh-engine/render/drawable.lisp create mode 100644 wh-engine/render/view.lisp create mode 100644 wh-engine/scene.lisp diff --git a/.gitignore b/.gitignore index bf4db1e..e7fbbf7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,7 @@ + +# KDE :') +.directory + # ---> CommonLisp *.FASL *.fasl diff --git a/README.md b/README.md index abf533e..6700c63 100644 --- a/README.md +++ b/README.md @@ -3,4 +3,9 @@ A game engine written in Common Lisp. ## Dependencies -- `cl-opengl` +- cl-sdl2 +- cl-opengl +- trivial-types +- [objective-lisp](https://bytes.keithhacks.cyou/keith/objective-lisp) +- 3d-vectors +- 3d-matrices diff --git a/run.lisp b/run.lisp new file mode 100644 index 0000000..0a02493 --- /dev/null +++ b/run.lisp @@ -0,0 +1,7 @@ +;; run.lisp +;; registers current dir and loads wh-engine + +(push (truename "./") asdf:*central-registry*) +(asdf:load-system 'wh-engine) + +(format t "**** wh-engine READY! ****~%") diff --git a/wh-engine.asd b/wh-engine.asd new file mode 100644 index 0000000..57f8ebd --- /dev/null +++ b/wh-engine.asd @@ -0,0 +1,19 @@ +;;;; wh-engine system definition +;;;; Copyleft (C) 2021 ~keith + +(defsystem "wh-engine" + :version "0.1.0" + :description "A game engine written in Common Lisp." + :author "~keith" + :license "GNU AGPLv3" + :depends-on ("sdl2" "cl-opengl" "trivial-types" "objective-lisp" "3d-vectors" "3d-matrices") + :components + ((:module "wh-engine" + :components ((:file "package") + (:file "main") + (:file "actor") + (:file "component") + (:file "scene") + (:file "render/drawable") + (:file "render/view")) + ))) diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp new file mode 100644 index 0000000..c448af0 --- /dev/null +++ b/wh-engine/actor.lisp @@ -0,0 +1,317 @@ +;;;; wh-engine/actor.lisp +(in-package wh-engine) + +(defclass actor () + ((id :documentation "This actor's unique ID." + :reader id + :type fixnum + :initarg :id + :initform (make-id)) + (name :documentation "This actor's human-readable name." + :accessor name + :type string + :initarg :name + :initform "") + (scene :documentation "The scene containing this actor." + :reader scene + :type (or weak-pointer null) + :initform nil) + (tags :documentation "This actor's tags." + :reader tags + :type (proper-list symbol) + :initarg :tags + :initform '(:default)) + (active-p :documentation "Whether or not this actor should be processed." + :reader active-p + :type boolean + :initform t) + (blocked-p :documentation "Whether or not this actor has a deactivated ancestor." + :type boolean + :initform nil) + (parent :documentation "This actor's parent." + :reader parent + :type (or weak-pointer null) + :initarg :parent + :initform nil) + (children :documentation "The actors this actor is a parent of." + :reader children + :type (proper-list weak-pointer) + :initform nil) + (components :documentation "The components attached to this actor." + :reader components + :type (proper-list component) + :initform nil) + (destroyed-p :documentation "If true, this actor will be unloaded." + :reader destroyed-p + :type boolean + :initform nil) + ;; Transform data + (location :documentation "The actor's location relative to its parent." + :reader location + :type vec2 + :initarg :location + :initform (vec2 0 0)) + (z-layer :documentation "The actor's Z layer." + :accessor z-layer + :type fixnum + :initarg :z-layer + :initform 0) + (rotation :documentation "The actor's rotation relative to its parent." + :reader rotation + :type single-float + :initarg :rotation + :initform 0.0) + (scale :documentation "The actor's scale relative to its parent." + :reader scale + :type vec2 + :initarg :scale + :initform (vec2 1 1)) + (matrix :documentation "Local-to-parent-space transformation matrix." + :reader matrix + :type mat3 + :initform (meye 3))) + (:documentation "Base class for entities in the game.")) + +(defmethod scene ((this actor)) + "The scene containing this actor." + (deref-pointer [this :slot scene])) + +(defmethod parent ((this actor)) + "This actor's parent." + (deref-pointer [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]))) + +(defmethod print-object ((this actor) stream) + (print-unreadable-object (this stream :type t :identity t) + (prin1 [this :slot id] stream) + (princ " ") + (prin1 [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])) + +(defmethod add-component ((this actor) component) + "Add a component to this object." + (let ((component-class (class-of component))) + (when [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)]) + 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)] + child) + +(defmethod remove-child ((this actor) child) + "Remove a child from this object." + (unless (eq [child parent] this) + (error "~S is not a child of ~S" child this)) + (setf [this :slot children] (remove child [this :slot children] :key #'weak-pointer-value)) + (setf [child :slot parent] nil) + [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])))) + +(defmethod has-tag ((this actor) tag) + "Check if this object has the specified tag." + (find tag [this tags])) + +(defmethod add-tag ((this actor) tag) + "Add a tag to this object." + (pushnew tag [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)] + (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)])) + +(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)])) + +(defmethod deactivate ((this actor)) + "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] + for child = (weak-pointer-value child-ptr) + do [child (parent-deactivated this)])) + +(defmethod activate ((this actor)) + "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)])) + +(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)])) + ) + +(defmethod destroy ((this actor)) + "Mark this object for unloading." + (unless [this destroyed-p] + ; Cleanup on aisle 5! + (loop for component in [this components] + when [component active-p] + do [component (destroy)]) + ; Remove from parent + (when [this parent] + [this parent (remove-child this)]) + (loop for child-ptr in [this children] + for child = (weak-pointer-value child-ptr) + do [child (destroy)]) + (when [this scene] + [this scene (remove-actor this)])) + (setf [this :slot destroyed-p] t)) + +;; Transform + +(defmethod initialize-instance :after ((this actor) &key) + [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) + (setf (m 0 0) (* sx rc) + (m 0 1) (* sy (- rs)) + (m 0 2) tx + (m 1 0) (* sx rs) + (m 1 1) (* sy rc) + (m 1 2) ty) + ))) + +(defmethod (setf location) (new-val (this actor)) + "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)]) + +(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)]) + +(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)]) + +(defmethod world-matrix ((this actor)) + "The local-to-world-space transformation matrix for this actor." + (if [this parent] + (m* [this matrix] [this parent world-matrix]) + [this matrix])) + +(defmethod local-matrix ((this actor)) + "The world-to-local-space transformation matrix for this actor." + (minv [this world-matrix])) + +(defmethod world-location ((this actor)) + "The world-space location of this actor." + (vxy (m* [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)))) + +(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)))) + +(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)))) + +(defmethod transform-svector ((this actor) vector) + "Transform vector from local space to parent space." + (declare (type vec2 vector)) + + (vxy (m* [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))) + +(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))) + +(defmethod rotate-by ((this actor) angle) + "Rotate this actor by the given angle." + (declare (type single-float angle)) + + (setf [this rotation] (+ [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))) diff --git a/wh-engine/component.lisp b/wh-engine/component.lisp new file mode 100644 index 0000000..505c7f2 --- /dev/null +++ b/wh-engine/component.lisp @@ -0,0 +1,67 @@ +;;;; wh-engine/component.lisp +(in-package wh-engine) + +(defclass component () + ((actor :documentation "The actor this component belongs to." + :reader actor + :type (or weak-pointer null) + :initform nil) + (active-p :documentation "Whether or not this component is active." + :reader active-p + :type boolean + :initarg :active-p + :initform t) + (started-p :documentation "Whether or not this component has been started yet." + :reader started-p + :type boolean + :initform nil)) + (:documentation "Base class for components attached to game entities.")) + +(defmethod actor ((this component)) + "The actor this component belongs to." + (deref-pointer [this :slot actor])) + +(defmethod scene ((this component)) + "The scene this component belongs to." + [this actor scene]) + +(defmethod destroyed-p ((this component)) + "If true, this component will be unloaded." + [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) + +(defmethod parent-changed ((this component)) + "Called when the component's actor's parent is changed." + nil) + +(defmethod deactivate ((this component)) + "Deactivate this component." + (setf [this :slot active-p] nil)) + +(defmethod activate ((this component)) + "Activate this component." + (setf [this :slot active-p] t)) + +(defmethod start ((this component)) + "Called before on-update the first time this component is processed." + (setf [this :slot started-p] t)) + +(defmethod update ((this component)) + "Called every game tick while this component and its actor are active." + nil) + +(defmethod destroy ((this component)) + "Called just before the component's actor is destroyed." + nil) diff --git a/wh-engine/main.lisp b/wh-engine/main.lisp new file mode 100644 index 0000000..e15d19c --- /dev/null +++ b/wh-engine/main.lisp @@ -0,0 +1,197 @@ +;;;; 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." + (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 [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." + (setq *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*) + (setq *id-counter* (+ id 1))) + id) + +(defvar *running-scenes* nil + "List of running scenes.") + +(defun add-scene (scene) + "Add a scene to the list of running scenes." + (declare (type scene scene)) + + (push scene *running-scenes*) + scene) + +(defun remove-scene (scene) + "Remove a scene from the list of running scenes." + (declare (type scene scene)) + + (setf *running-scenes* (remove scene *running-scenes*)) + scene) + +(defun get-scene (scene-id) + "Get a scene by its ID." + (find-if (lambda (scene) (eq [scene id] scene-id)) *running-scenes*)) + +(defun update-all-scenes () + "Update all running scenes." + (loop for scene in *running-scenes* + do [scene (update)])) + +(defvar *view-width* 384 + "View-space width in pixels.") +(defvar *view-height* 256 + "View-space height in pixels.") +(defvar *view-ppu* 64 + "Pixels in view-space per unit in world-space.") + +(defvar *pixel-scale* 2 + "Scaling factor for rendered pixels.") + +(defvar *world-drawables* nil + "List of all known drawables.") +(defvar *world-views* nil + "List of all known views.") + +(defun register-test-scene () + (let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view) + (setf test-scene (make-instance 'scene + :id -1 + :name "Test scene")) + (add-scene test-scene) + + (setf test-actor (make-instance 'actor + :name "Actor")) + [test-scene (add-actor test-actor)] + + (setf test-drawable (make-instance 'drawable-test)) + [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)] + + [test-actor-2 (add-component (make-instance 'drawable-test + :colour (vec4 0.0 1.0 0.0 1.0))) + ] + + (setf camera-actor (make-instance 'actor + :name "Camera" + :rotation (coerce (/ pi -4) 'single-float))) + [test-scene (add-actor camera-actor)] + + (setf camera-view (make-instance 'view)) + [camera-actor (add-component camera-view)] + + test-scene)) + +(defun run () + "Run the main game loop." + (sdl2:with-init (:everything) + (format t "wh-engine: using SDL ~D.~D.~D~%" + sdl2-ffi:+sdl-major-version+ + sdl2-ffi:+sdl-minor-version+ + sdl2-ffi:+sdl-patchlevel+) + (finish-output) + (sdl2:with-window (win :flags '(:shown :opengl) + :w *view-width* :h *view-height* + :title (format nil "wh-engine ~D.~D.~D (Affero GPL; NON-FREE USAGE PROHIBITED)" + (nth 0 +version+) (nth 1 +version+) (nth 2 +version+))) + (sdl2:with-gl-context (gl-context win) + (sdl2:gl-make-current win gl-context) + (gl:viewport 0 0 *view-width* *view-height*) + (gl:matrix-mode :projection) + (gl:ortho 0 *view-width* + 0 *view-height* + -1024 1024) + (gl:matrix-mode :modelview) + (gl:load-identity) + (gl:clear-color 0.0 0.0 0.0 1.0) + (gl:clear :color-buffer) + (gl:clear :depth-buffer) + (gl:enable :depth-test) + + (sdl2:with-event-loop (:method :poll) + (:quit () t) + (:idle () + (update-all-scenes) + (gl:clear :color-buffer) + (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]) + do (progn + (unless (eq [view render-pass] render-pass) + (setf render-pass [view render-pass]) + (gl:clear :depth-buffer) + ) + [view (render-view *world-drawables*)]))) + (gl:flush) + (sdl2:gl-swap-window win))) + )))) diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp new file mode 100644 index 0000000..69a41e0 --- /dev/null +++ b/wh-engine/package.lisp @@ -0,0 +1,82 @@ +;;;; wh-engine/package.lisp +;;;; root package of wh-engine + +(defpackage wh-engine + (:nicknames whe) + (:use common-lisp 3d-vectors 3d-matrices) + (:import-from sb-ext + weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value) + (:export + ;; main.lisp + +version+ ensure-version + deref-pointer points-to ensure-live + vxy1 vxy-trunc + make-id fixed-id + *running-scenes* + add-scene remove-scene get-scene update-all-scenes + *view-width* *view-height* *view-ppu* *pixel-scale* + register-test-scene + run + + ;; actor.lisp + actor + ; properties + id name scene tags active-p parent children components destroyed-p + location z-layer rotation scale matrix + ; virtual properties + tree-active-p + world-matrix local-matrix + world-location + ; methods + get-component add-component + add-child remove-child + has-tag add-tag remove-tag + parent-deactivated parent-activated parent-changed + deactivate activate + update + destroy + transform-point world-point local-point + transform-svector transform-vector + translate-by rotate-by scale-by + + ;; component.lisp + component + ; properties + actor active-p started-p + ; virtual properties + scene destroyed-p + ; methods + attach + parent-deactivated parent-activated parent-changed + deactivate activate + start update + destroy + + ;; scene.lisp + scene + ; properties + id name actors destroyed-p + ; methods + add-actor remove-actor + get-actor get-tagged-actors + update + destroy + + ;; render/drawable.lisp + drawable + ; virtual properties + culling-box + ; methods + draw + + drawable-test + + ;; render/view.lisp + view + ; properties + render-pass render-mask cull-p + ; virtual properties + view-matrix world-matrix + ; methods + view-point render-view render-drawable + )) diff --git a/wh-engine/render/drawable.lisp b/wh-engine/render/drawable.lisp new file mode 100644 index 0000000..07a3053 --- /dev/null +++ b/wh-engine/render/drawable.lisp @@ -0,0 +1,42 @@ +;;;; wh-engine/render/drawable.lisp +(in-package wh-engine) + +(defclass drawable (component) + () + (:documentation "Base class for components that draw graphics.")) + +(defmethod start :after ((this drawable)) + ; Register + (pushnew (make-weak-pointer this) *world-drawables*)) + +(defmethod destroy :before ((this drawable)) + ; Unregister + (setf *world-drawables* (delete this *world-drawables* :key #'weak-pointer-value))) + +(defmethod culling-box ((this drawable)) + "The local-space bounding box used for culling." + (cons (vec2 0 0) (vec2 0 0))) + +(defmethod draw ((this drawable) view) + "Draw this object." + nil) + +(defclass drawable-test (drawable) + ((colour :documentation "Colour of the test quad." + :accessor colour + :type vec4 + :initarg :colour + :initform (vec4 1.0 0.0 1.0 1.0))) + (:documentation "Basic drawable test.")) + +(defmethod culling-box ((this drawable-test)) + (cons (vec2 -0.5 -0.5) (vec2 0.5 0.5))) + +(defmethod draw ((this drawable-test) view) + (gl:begin :quads) + (gl:color (vx4 [this colour]) (vy4 [this colour]) (vz4 [this colour]) (vw4 [this colour])) + (gl:vertex -0.5 -0.5 0.0 1.0) + (gl:vertex 0.5 -0.5 0.0 1.0) + (gl:vertex 0.5 0.5 0.0 1.0) + (gl:vertex -0.5 0.5 0.0 1.0) + (gl:end)) diff --git a/wh-engine/render/view.lisp b/wh-engine/render/view.lisp new file mode 100644 index 0000000..f24ce06 --- /dev/null +++ b/wh-engine/render/view.lisp @@ -0,0 +1,96 @@ +;;;; wh-engine/render/view.lisp +(in-package wh-engine) + +(defun sort-world-views () + "Re-sort the *world-views* list by render pass." + (sort *world-views* #'< :key (lambda (v) [(deref-pointer v) render-pass]))) + +(defclass view (component) + ((render-pass :documentation "The render pass this view should be drawn in." + :reader render-pass + :type fixnum + :initarg :render-pass + :initform 0) + (render-mask :documentation "Only include actors with at least one of these tags." + :accessor render-mask + :type (proper-list symbol) + :initarg :render-mask + :initform '(:default)) + (cull-p :documentation "Whether or not to skip rendering out-of-frame objects." + :accessor cull-p + :type boolean + :initarg :cull-p + :initform t)) + (: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) + (sort-world-views)) + +(defmethod start :after ((this view)) + ; 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)))) + +(defmethod view-matrix ((this view)) + "The world-to-view-space transformation matrix for this object." + ;; view-space = local-space, scaled by ppu, then offset so [-width/2..width/2] -> [0..width] + ;; (Y+ is still up in view-space) + (m* (mat *view-ppu* 0 (/ *view-width* 2) + 0 *view-ppu* (/ *view-height* 2) + 0 0 1) + [this actor local-matrix])) + +(defmethod world-matrix ((this view)) + "The view-to-world-space transformation matrix for this object." + (minv [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)))) + +(defmethod render-view ((this view) drawables) + "Render everything in this view, given all drawables in the world." + (let ((view-matrix [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)]) + )) + +(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]) + box-a box-b) + (setf box-a (vxy-trunc (m* view-matrix + (m* drawable-matrix (vxy1 (car drawable-culling-box)))))) + (setf box-b (vxy-trunc (m* view-matrix + (m* drawable-matrix (vxy1 (cdr drawable-culling-box)))))) + ;; If it's in view at all, either its top-right corner is >= bottom-left of view, + ;; or its bottom-left is <= top-right of view + (or (v>= (vmax box-a box-b) (car view-box)) + (v<= (vmin box-a box-b) (cdr view-box))))) + +(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 + (cons (vec2 0 0) (vec2 *view-width* *view-height*)))) + (gl:push-matrix) + (gl:translate 0 0 [drawable actor z-layer]) + (gl:mult-transpose-matrix (opengl-matrix drawable-matrix)) + [drawable (draw this)] + (gl:pop-matrix)))) diff --git a/wh-engine/scene.lisp b/wh-engine/scene.lisp new file mode 100644 index 0000000..206992b --- /dev/null +++ b/wh-engine/scene.lisp @@ -0,0 +1,70 @@ +;;;; wh-engine/scene.lisp +(in-package wh-engine) + +(defclass scene () + ((id :documentation "This scene's unique ID." + :reader id + :type fixnum + :initarg :id + :initform 0) + (name :documentation "This scene's human-readable name." + :accessor name + :type string + :initarg :name + :initform "") + (actors :documentation "A list containing all actors in the scene." + :reader actors + :type (proper-list actor) + :initform nil) + (destroyed-p :documentation "If true, this scene will be unloaded." + :reader destroyed-p + :type boolean + :initform nil)) + (:documentation "A scene containing game entities.")) + +(defmethod print-object ((this scene) stream) + (print-unreadable-object (this stream :type t :identity t) + (prin1 [this :slot id] stream) + (princ " ") + (prin1 [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)) + actor) + +(defmethod remove-actor ((this scene) actor) + "Remove an actor from this scene." + (unless (eq [actor scene] this) + (error "~S is not in scene ~S" actor this)) + (setf [this :slot actors] (remove actor [this :slot actors] :key #'weak-pointer-value)) + (setf [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])) + +(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]) + 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)])) + +(defmethod destroy ((this scene)) + "Mark this scene for unloading." + (unless [this destroyed-p] + ; We're dead, clean up actors + (loop for actor in [this actors] + do [actor (destroy)]) + (remove-scene this)) + (setf [this :slot destroyed-p] t))