From 7376c21c076fd552672c64fbbf790fc476ff619a Mon Sep 17 00:00:00 2001 From: John Connors Date: Mon, 25 Aug 2008 18:26:11 +0100 Subject: [PATCH] Adding forgotten file --- actor.lisp | 88 +++++++++++++++++++++++++++++ camera.lisp | 171 ++++++++++++++++++++++++++------------------------------ lambdamundo.asd | 6 +- main.lisp | 35 +++++++----- repl.lisp | 2 +- 5 files changed, 193 insertions(+), 109 deletions(-) create mode 100644 actor.lisp diff --git a/actor.lisp b/actor.lisp new file mode 100644 index 0000000..44ae953 --- /dev/null +++ b/actor.lisp @@ -0,0 +1,88 @@ + + +(in-package :lambdamundo) + +(defparameter *actors* (make-array 0 :adjustable t :fill-pointer 0)) + +(def-tuple-class actor + (:tuples + ((location :type vertex3d) + (velocity :type vector3d) + (orientation :type quaternion) + (w-velocity :type vector3d)) + :slots + ((dv :type single-float :initform 0.0 :accessor dv-of) + (dw :type single-float :initform 0.0 :accessor dw-of)))) + + +(defmethod initialize-instance :after ((self actor) &rest args) + (declare (ignore args)) + (setf (aref (orientation-of% self) 3) 1.0) + (vector-push-extend self *actors*)) + +(def-tuple-op angular-velocity + ((vector vector3d (vx vy vz)) + (quat quaternion (qx qy qz qw))) + "Calculate dq/dt as a quat from an angular velocity" + (:return quaternion + (quaternion-scale + (quaternion-product + (vector3d-quaternion vector) + quat) 0.5))) + +(defmethod update-position ((a actor)) + ;; update position + (setf (location-of a) + (vector3d-vertex3d + (vector3d-sum + (vertex3d-vector3d (location-of a)) + (velocity-of a))))) + +(defmethod update-dv ((a actor)) + ;; update velocity + (setf (velocity-of a) + (vector3d-scale + (velocity-of a) + (dv-of a)))) + +(defmethod update-dw ((a actor)) + ;; update angluar velocity + (setf (w-velocity-of a) + (vector3d-scale (w-velocity-of a) (dw-of a)))) + +(defmethod update-orientation ((a actor)) + ;; update orientation + (setf (orientation-of a) + (quaternion-unitize + (quaternion-sum + (orientation-of a) + (angular-velocity + (w-velocity-of a) + (orientation-of a)))))) + + + +(defmethod update ((a actor)) + (update-dv a) + (update-dw a) + (update-position a) + (update-orientation a)) + + +(defmethod up-of ((a actor)) + "Return a tuple vector representing the up axis of the camera." + (quaternion-transform-vector3d + (vector3d* 0.0 1.0 0.0) + (orientation-of a))) + +(defmethod direction-of ((a actor)) + "Return a tuple vector representing the z axis of the camera." + (quaternion-transform-vector3d + (vector3d* 0.0 0.0 1.0) + (orientation-of a))) + +(defmethod cross-of ((a actor)) + "Return a tuple vector representing the x axis of the camera." + (quaternion-transform-vector3d + (vector3d* 1.0 0.0 0.0) + (orientation-of a))) diff --git a/camera.lisp b/camera.lisp index 29a088a..08cf34f 100644 --- a/camera.lisp +++ b/camera.lisp @@ -3,34 +3,12 @@ ;; camera -- this could be an actor.. -(def-tuple-class camera - (:tuples - ((position :type vertex3d) - (orientation :type quaternion)) - :slots - ((speed :initform 1.0 :accessor speed-of :type single-float) - (zoom-speed-of :initform 1.0 :accessor zoom-speed-of :type single-float)))) - - -(defmethod up-of ((cam camera)) - "Return a tuple vector representing the up axis of the camera." - (quaternion-transform-vector3d - (vector3d* 0.0 1.0 0.0) - (orientation-of cam))) - -(defmethod direction-of ((cam camera)) - "Return a tuple vector representing the z axis of the camera." - (quaternion-transform-vector3d - (vector3d* 0.0 0.0 1.0) - (orientation-of cam))) - -(defmethod cross-of ((cam camera)) - "Return a tuple vector representing the x axis of the camera." - (quaternion-transform-vector3d - (vector3d* 1.0 0.0 0.0) - (orientation-of cam))) - -(def-tuple-op update-vertex +(defclass camera (actor) + ((speed :initform 1.0 :accessor speed-of :type single-float) + (zoom-speed-of :initform 1.0 :accessor zoom-speed-of :type single-float))) + + +(def-tuple-op translate-scaled-vertex ((p vertex3d (x y z w)) (v vector3d (vx vy vz)) (delta single-float)) @@ -42,13 +20,20 @@ (+ z (* vz delta)) w))) -(defmethod move ((cam camera) dx dy) +(defmethod pan ((cam camera) dx dy) "Move the camera by dx along cross vector and by dy along z vector" - (setf (position-of cam) - (update-vertex (position-of cam) (direction-of cam) (* dy (- (speed-of cam))))) - (setf (position-of cam) (update-vertex (position-of cam) (cross-of cam) (* dx (speed-of cam))))) + (setf (location-of cam) + (translate-scaled-vertex + (location-of cam) + (direction-of cam) + (* dy (- (speed-of cam))))) + (setf (location-of cam) + (translate-scaled-vertex + (location-of cam) + (cross-of cam) + (* dx (speed-of cam))))) -(defmethod rotate ((cam camera) dx dy) +(defmethod dolly ((cam camera) dx dy) (setf (orientation-of cam) (quaternion-product (orientation-of cam) @@ -64,46 +49,34 @@ (angle-axis* cx cy cz (* *mouse-sensitivity* dy))))))) (defmethod zoom ((cam camera) dz) - (setf (position-of cam) + (setf (location-of cam) (with-vertex3d - (position-of cam) + (location-of cam) (px py pz pw) (vertex3d* px py (- pz (* (zoom-speed-of cam))) pw)))) -(defmethod camera-modelview-matrix ((cam camera)) - (gl:matrix-mode gl:+modelview+) - (gl:load-identity) - (with-vector3d - (vector3d-sum (vertex3d-vector3d (position-of cam)) (direction-of cam)) - (lx ly lz) - (with-vector3d - (vertex3d-vector3d (position-of cam)) - (px py pz) - (with-vector3d - (up-of cam) - (ux uy uz) - #| (format *debug-io* "Look at~&Position ~A ~A ~A~&LookAt ~A ~A ~AUp ~A ~A ~A" px py pz lx ly lz ux uy uz) |# - (glu:look-at - px py pz - lx ly lz - ux uy uz))))) - -(defmethod camera-modelview-matrix44 ((cam camera)) - "Return a matrix44 equivalent to glu:look-at" - (with-vector3d - (direction-of cam) - (fx fy fz) - (with-vector3d - (up-of cam) - (ux uy uz) - (with-vector3d - (cross-of cam) - (sx sy sz) - (matrix44* sx sy sz 0.0 - ux uy uz 0.0 - fx fy fz 0.0 - 0.0 0.0 0.0 1.0))))) +(defparameter *modelview-debug* (make-array 16 :element-type '(single-float))) + +;; (defmethod camera-modelview-matrix ((cam camera)) +;; (gl:matrix-mode gl:+modelview+) +;; (gl:load-identity) +;; (with-vector3d +;; (vector3d-sum (vertex3d-vector3d (location-of cam)) (direction-of cam)) +;; (lx ly lz) +;; (with-vector3d +;; (vertex3d-vector3d (location-of cam)) +;; (px py pz) +;; (with-vector3d +;; (up-of cam) +;; (ux uy uz) +;; #| (format *debug-io* "Look at~&Position ~A ~A ~A~&LookAt ~A ~A ~AUp ~A ~A ~A" px py pz lx ly lz ux uy uz) |# +;; (glu:look-at +;; px py pz +;; lx ly lz +;; ux uy uz))))) + + (def-tuple-op gl-load-matrix44 ((mat matrix44 (e00 e01 e02 e03 @@ -111,47 +84,63 @@ e20 e21 e22 e23 e30 e31 e32 e33))) "Load a matrix44 onto the opengl stack" - (let ((mat (make-array 16 :element-type 'single-float))) - (setf (aref mat 0) e00) - (setf (aref mat 1) e10) - (setf (aref mat 2) e20) - (setf (aref mat 3) e30) - - (setf (aref mat 4) e01) - (setf (aref mat 5) e11) - (setf (aref mat 6) e21) - (setf (aref mat 7) e31) - - (setf (aref mat 8) e02) - (setf (aref mat 9) e12) - (setf (aref mat 10) e22) - (setf (aref mat 11) e32) - - (setf (aref mat 12) e03) - (setf (aref mat 13) e13) - (setf (aref mat 14) e23) - (setf (aref mat 15) e33)) - (gl:load-matrix-f mat)) + (cffi:with-foreign-object (glmat :float 16) + (dotimes (i 16) + (setf (cffi:mem-aref glmat :float i) (matrix44-aref mat i))) + (gl::%load-matrix-f glmat))) +(defmethod camera-modelview-matrix ((cam camera)) + "Return a matrix44 equivalent to glu:look-at" + (gl:matrix-mode gl:+modelview+) + (gl:load-identity) + (gl-load-matrix44 + (with-vertex3d + (location-of cam) + (lx ly lz lw) + (with-vector3d + (direction-of cam) + (fx fy fz) + (with-vector3d + (up-of cam) + (ux uy uz) + (with-vector3d + (cross-of cam) + (sx sy sz) + (matrix44* sx sy sz lx + ux uy uz ly + fx fy fz lw + 0.0 0.0 0.0 1.0))))))) + + + (defmacro with-camera (camera &body forms) `(progn (camera-modelview-matrix ,camera) ,@forms)) -(defparameter *camera* (make-instance 'camera - :position (make-vertex3d* 0.0 0.0 -5.0 1.0) +(defun make-camera () (make-instance 'camera + :location (make-vertex3d* 0.0 0.0 -5.0 1.0) :orientation (make-quaternion* 0.0 0.0 0.0 1.0))) +(defparameter *camera* nil) + +(defun set-current-camera (cam) (setf *camera* cam)) + (defun reset-camera () (setf *camera* (make-instance 'camera :position (make-vertex3d* 0.0 0.0 -5.0 1.0) :orientation (make-quaternion* 0.0 0.0 0.0 1.0)))) + ;; camera change far plane function ;; (make-key-function ;; (char-code #\Z) ;; (if (eql (glfw:get-key glfw:+key-lshift+) glfw:+press+) ;; (incf *z-far* 1.0) ;; (decf *z-far* 1.0))) + +(defmethod render ((c camera)) + (camera-modelview-matrix c) + (gl:get-floatv gl:+modelview-matrix+ *modelview-debug*)) diff --git a/lambdamundo.asd b/lambdamundo.asd index c98906d..48dd58f 100644 --- a/lambdamundo.asd +++ b/lambdamundo.asd @@ -1,5 +1,5 @@ -;;;; blockworld.asd +;;;; lambdamundo.asd (in-package :asdf) (defsystem :lambdamundo @@ -24,12 +24,12 @@ (:file "keyboard") (:file "keymaps") (:file "mouse") - (:file "camera") - (:file "drawing") (:file "window") (:file "repl") (:file "actor") (:file "turtle") + (:file "camera") + (:file "drawing") (:file "npc") (:file "main"))) diff --git a/main.lisp b/main.lisp index 43a49da..ed4efc7 100644 --- a/main.lisp +++ b/main.lisp @@ -45,14 +45,17 @@ (defun render-debug () (glrepl::render-string - (format nil "Mouse wheel pos ~A ~A " *mouse-wheel-pos* *mouse-wheel-delta*) + (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 0) (aref *modelview-debug* 1) (aref *modelview-debug* 2) (aref *modelview-debug* 3)) 0 20) (glrepl::render-string - (format nil "Camera pos ~A " (multiple-value-list (position-of *camera*))) 0 21) + (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 4) (aref *modelview-debug* 5) (aref *modelview-debug* 6) (aref *modelview-debug* 7)) + 0 21) (glrepl::render-string - (format nil "Swank connections ~A" swank::*connections*) 0 22) + (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 8) (aref *modelview-debug* 9) (aref *modelview-debug* 10) (aref *modelview-debug* 11)) + 0 22) (glrepl::render-string - (format nil "Vendor ~A " (gl:get-string gl:+vendor+)) 0 19)) + (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 12) (aref *modelview-debug* 13) (aref *modelview-debug* 14) (aref *modelview-debug* 14)) + 0 23)) (cffi:defcallback lambdamundo-mouse-wheel-callback :void ((pos :int)) @@ -160,7 +163,7 @@ (defun update-world (dt) (incf *frames*) (when *mouse-wheel-changed* - (move *camera* 0.0 (* *mouse-wheel-delta* dt)) + (pan *camera* 0.0 (* *mouse-wheel-delta* dt)) (setf *mouse-wheel-changed* nil))) (defmacro one-shot (&rest forms) @@ -215,17 +218,18 @@ (iterate (while (zerop (length swank::*connections*))) (cl:sleep 0.1) - (format t ".")) + (format t ".") + (force-output)) (format t "~%Connected.~%"))) (defun end-swank () (when (not (zerop (length swank::*connections*))) (swank::end-session *swank-port*)) - (setf *swank-port* nil)) + (setf *swank-port* nil)) (defun oh-bum () "Cleanup when something went wrong." - (end-swank) +;; (end-swank) (glfw:close-window) (glfw:terminate)) @@ -233,6 +237,7 @@ + ;; (defun lambdamundo () (if (glfw::init) @@ -240,7 +245,7 @@ (setf glrepl:*glwindow* (make-instance 'glrepl-window)) (add-line glrepl:*glwindow*) (add-line glrepl:*glwindow*) - (add-string glrepl:*glwindow* "(one-shot-compile #P\"mesh-compiler.lisp\"") + (add-string glrepl:*glwindow* "(one-shot-compile #P\"mesh-compiler.lisp)\"") (if (glfw:open-window (win-width-of *glwindow*) (win-height-of *glwindow*) @@ -250,19 +255,21 @@ (progn (begin-gl) (begin-swank) - (format t "Making font..") - (setf (font-of glrepl:*glwindow*) (make-font (merge-pathnames #P"VeraMono.ttf")));; prbly shld be mber of window - (format t "Done..") + (format t "Making font..~%") + (setf (font-of glrepl:*glwindow*) (make-font (merge-pathnames #P"VeraMono.ttf"))) + (format t "Done.") + (format t "Compiling mesh compiler..~%") (gl-ext:load-extension "ARB_vertex_program") (gl-ext:load-extension "ARB_vertex_buffer_object") (one-shot-compile #P"mesh-compiler.lisp") + (format t "Done..~%") (glfw:swap-interval 1) (glfw:enable glfw:+key-repeat+) (callback-set) - ;; (glrepl::dump (aref *font-images* 65)) + (set-current-camera (make-camera)) (main-loop) (callback-clear) - (end-swank) +;; (end-swank) (end-gl) (if (= (glfw::get-window-param glfw:+opened+) glfw:+true+) (glfw:close-window)) diff --git a/repl.lisp b/repl.lisp index 44b93fa..1bb1b37 100644 --- a/repl.lisp +++ b/repl.lisp @@ -11,7 +11,7 @@ (in-package :swank) (defun start-session (port) - "Starts a swank session and returns " + "starts a swank session and returns " (let* ((announce-fn #'simple-announce-function) (external-format (find-external-format-or-lose *coding-system*)) (socket (create-socket *loopback-interface* port)) -- 2.11.4.GIT