Permalink
Browse files

Player camera and movement

  • Loading branch information...
borodust committed Apr 20, 2017
1 parent fc34a5b commit 5a1adebdb21c1f8530eb6839ff039083737cf51c
@@ -24,8 +24,7 @@
(with-slots (light program color) this
(with-active-shading-program (program)
(setf (program-uniform-variable program "modelViewProjection") (model-view-projection-matrix)
(program-uniform-variable program "normalTransform") (mat4->mat3 (mult *view-matrix*
*model-matrix*))
(program-uniform-variable program "normalTransform") (mat4->mat3 *model-matrix*)
(program-uniform-variable program "baseColor") color)
(apply-light-source light program)
(call-next-method))))
@@ -1,10 +1,15 @@
(in-package :mortar-combat)
(defclass player-camera (camera-node) ())
(defclass player-camera (camera-node)
((player :initarg :player)
(front-gaze :initform (vec3 0.0 0.0 -1.0))))
(defmethod scene-pass ((this player-camera) pass input)
(setf (transform-of this) (mult (translation-mat4 0 -4 -50)
(euler-angles->mat4 (vec3 (/ pi 4) (/ pi 8) 0))))
(with-slots (player front-gaze) this
(let* ((pos (position-of player))
(rotation (rotation-of player)))
(setf (transform-of this) (mult (euler-angles->mat4 (vec3 (- (x rotation)) (y rotation) 0.0))
(translation-mat4 (- (x pos)) -10.0 (- (y pos)))))))
(call-next-method))
@@ -24,8 +24,7 @@
(with-slots (mesh-asset light program color) this
(with-active-shading-program (program)
(setf (program-uniform-variable program "modelViewProjection") (model-view-projection-matrix)
(program-uniform-variable program "normalTransform") (mat4->mat3 (mult *view-matrix*
*model-matrix*))
(program-uniform-variable program "normalTransform") (mat4->mat3 *model-matrix*)
(program-uniform-variable program "baseColor") color)
(apply-light-source light program)
(loop for (name . offset) across (mesh-asset-bones mesh-asset)
@@ -67,17 +66,7 @@
run-animation run
rest-animation rest
program p))
(call-next-method)
(instantly ()
(let ((node (find-node (model-root-of this) :dude-animation)))
(subscribe-body-to (keyboard-event (key state)) (events)
(case key
(:w (case state
(:pressed (play-node-animation node run-animation 0.15))
(:released (play-node-animation node rest-animation 0.15))))
(:d (case state
(:pressed (play-node-animation node strafe-animation 0.15))
(:released (play-node-animation node rest-animation 0.15)))))))))))
(call-next-method))))
(defmethod model-graph-assembly-flow ((this dude-model))
@@ -15,13 +15,16 @@
(let ((eve (events)))
(flet ((register-callback (class action)
(push (cons class (subscribe-to class action eve)) callbacks))
(process-button-event (ev)
(process-key-event (ev)
(when-let ((action (gethash (key-from ev) key-table)))
(funcall action (state-from ev))))
(process-button-event (ev)
(when-let ((action (gethash (button-from ev) key-table)))
(funcall action (state-from ev))))
(process-cursor-event (ev)
(when cursor-action
(funcall cursor-action (x-from ev) (y-from ev)))))
(register-callback 'keyboard-event #'process-button-event)
(register-callback 'keyboard-event #'process-key-event)
(register-callback 'mouse-event #'process-button-event)
(register-callback 'cursor-event #'process-cursor-event)))))
@@ -5,7 +5,9 @@
(defclass mortar-combat (enableable generic-system)
((scene :initform nil))
((scene :initform nil)
(keymap :initform (make-instance 'keymap))
(player :initform nil))
(:default-initargs :depends-on '(graphics-system
physics-system
audio-system)))
@@ -15,29 +17,66 @@
(engine-system 'mortar-combat))
(defun scenegraph-flow ()
(defun scenegraph-flow (player)
(scenegraph
(transform-node
((projection-node :aspect (/ 800 600))
(player-camera
((player-camera :player player)
(room-model)
((transform-node :translation (vec3 4.0 0.0 0.0))
(mortar-model)
((dude-model :color (vec3 0.9 0.4 0.4)))))))))
(defmethod initialize-system :after ((this mortar-combat))
(with-slots (scene) this
(with-slots (scene player keymap) this
(register-resource-loader (make-resource-loader (asset-path "font.brf")
(asset-path "dude-and-mortar.brf")))
(setf player (make-instance 'player))
(let ((prev-x nil)
(prev-y nil)
(movement-keys))
(labels ((rotate-camera (x y)
(when (and prev-x prev-y)
(let ((ax (/ (- y prev-y) 1000))
(ay (/ (- x prev-x) 1000)))
(look-at player ax ay)))
(setf prev-x x
prev-y y))
(key-velocity (key)
(case key
(:w (vec2 0.0 -10.0))
(:s (vec2 0.0 10.0))
(:a (vec2 -10.0 0.0))
(:d (vec2 10.0 0.0))))
(update-velocity ()
(setf (player-velocity player) (reduce #'add movement-keys
:key #'key-velocity
:initial-value (vec2))))
(update-buttons (button)
(lambda (state)
(case state
(:pressed (push button movement-keys))
(:released (deletef movement-keys button)))
(update-velocity))))
(bind-cursor keymap #'rotate-camera)
(bind-button keymap :w (update-buttons :w))
(bind-button keymap :s (update-buttons :s))
(bind-button keymap :a (update-buttons :a))
(bind-button keymap :d (update-buttons :d))))
(enable-keymap keymap)
(run (>> (-> ((host)) ()
(lock-cursor)
(setf (viewport-title) "Mortar Combat")
(setf (viewport-size) (vec2 800 600)))
(-> ((physics)) ()
(setf (gravity) (vec3 0.0 -9.81 0.0)))
(-> ((graphics)) ()
(gl:viewport 0 0 800 600))
(scenegraph-flow)
(scenegraph-flow player)
(instantly (scenegraph-root)
(setf scene (make-scene (make-pass-chain (make-simulation-pass)
(make-rendering-pass))
@@ -24,8 +24,7 @@
(with-slots (mesh-asset light program color) this
(with-active-shading-program (program)
(setf (program-uniform-variable program "modelViewProjection") (model-view-projection-matrix)
(program-uniform-variable program "normalTransform") (mat4->mat3 (mult *view-matrix*
*model-matrix*))
(program-uniform-variable program "normalTransform") (mat4->mat3 *model-matrix*)
(program-uniform-variable program "baseColor") color)
(apply-light-source light program)
(loop for (name . offset) across (mesh-asset-bones mesh-asset)
@@ -0,0 +1,39 @@
(in-package :mortar-combat)
(defvar *forward-gaze* (vec3 0.0 0.0 -1.0))
(defclass player ()
((position :initform (vec2 0.0 18.0))
(rotation :initform (vec2 0.0 0.0) :reader rotation-of)
(updated-at :initform (real-time-seconds))
(velocity :initform (vec2 0.0 0.0))))
(defun flush-position (player)
(with-slots (position updated-at velocity rotation) player
(let ((now (real-time-seconds)))
(setf position (add position (mult (angle->mat2 (y rotation))
velocity
(- now updated-at)))
updated-at now))))
(defmethod position-of ((this player))
(with-slots (position) this
(flush-position this)
position))
(defun (setf player-velocity) (vec2 player)
(with-slots (position velocity) player
(flush-position player)
(setf velocity vec2)))
(defun look-at (player x-angle y-angle)
(with-slots (rotation) player
(incf (y rotation) y-angle)
(incf (x rotation) x-angle)))
@@ -1,6 +1,21 @@
(in-package :mortar-combat)
(defclass room-floor (disposable)
(geom))
(defmethod initialize-instance :after ((this room-floor) &key)
(with-slots (geom) this
(setf geom (make-instance 'plane-geom :normal (vec3 0.0 1.0 0.0)))))
(define-destructor room-floor (geom)
(dispose geom))
;;;
;;;
;;;
@@ -31,8 +46,7 @@
(with-slots (light program color) this
(with-active-shading-program (program)
(setf (program-uniform-variable program "modelViewProjection") (model-view-projection-matrix)
(program-uniform-variable program "normalTransform") (mat4->mat3 (mult *view-matrix*
*model-matrix*))
(program-uniform-variable program "normalTransform") (mat4->mat3 *model-matrix*)
(program-uniform-variable program "baseColor") color)
(apply-light-source light program)
(call-next-method))))
@@ -42,18 +56,26 @@
;;;
;;;
(defclass room-model (model)
((mesh :initform nil)
((floor :initform nil)
(mesh :initform nil)
(program :initform nil)))
(defmethod initialization-flow ((this room-model) &key)
(with-slots (program) this
(with-slots (program floor) this
(>> (resource-flow (shading-program-resource-name "passthru-program"))
(instantly (p)
(setf program p))
(-> ((physics)) ()
(setf floor (make-instance 'room-floor)))
(call-next-method))))
(defmethod discard-node :before ((this room-model))
(with-slots (floor) this
(dispose floor)))
(defmethod model-graph-assembly-flow ((this room-model))
(with-slots (program) this
(scenegraph
@@ -1,5 +1,8 @@
(in-package :mortar-combat)
(defvar *identity-mat4* (identity-mat4))
(defun asset-path (file)
(merge-pathnames file (merge-working-pathname (property :assets "assets/"))))
@@ -29,6 +29,7 @@
:components ((:file "packages")
(:file "utils")
(:file "keymap")
(:file "player")
(:file "camera")
(:file "room")
(:file "ball")

0 comments on commit 5a1adeb

Please sign in to comment.