camera.lisp

   1
   2 (in-package :lambdamundo)
   3
   4 ;; camera -- this could be an actor..
   5
   6 (defclass camera (actor)
   7   ((speed :initform 1.0 :accessor speed-of :type single-float)
   8    (zoom-speed-of :initform 1.0 :accessor zoom-speed-of :type single-float)))
   9
  10
  11 (def-tuple-op translate-scaled-vertex
  12     ((p vertex3d (x y z w))
  13      (v vector3d (vx vy vz))
  14      (delta single-float))
  15       "Move the given vertex in the direction of the given vector, uniformly scaled by delta."
  16       (:return vertex3d
  17                (vertex3d*
  18                 (+ x (* vx delta))
  19                 (+ y (* vy delta))
  20                 (+ z (* vz delta))
  21                 w)))
  22
  23 (defmethod pan ((cam camera) dx dy)
  24   "Move the camera by dx along cross vector and by dy along z vector"
  25   (setf (location-of cam)
  26         (translate-scaled-vertex
  27          (location-of cam)
  28          (direction-of cam)
  29          (* dy (- (speed-of cam)))))
  30   (setf (location-of cam)
  31         (translate-scaled-vertex
  32          (location-of cam)
  33          (cross-of cam)
  34          (* dx  (speed-of cam)))))
  35
  36 (defmethod dolly ((cam camera) dx dy)
  37   (setf (orientation-of cam)
  38         (quaternion-product
  39          (orientation-of cam)
  40          (angle-axis-quaternion
  41           (angle-axis* 0.0 0.0 1.0  (* *mouse-sensitivity* dy)))))
  42   (setf (orientation-of cam)
  43         (with-vector3d
  44             (cross-of cam)
  45             (cx cy cz)
  46           (quaternion-product
  47            (orientation-of cam)
  48            (angle-axis-quaternion
  49             (angle-axis* cx cy cz  (* *mouse-sensitivity* dy)))))))
  50
  51 (defmethod zoom ((cam camera) dz)
  52   (setf (location-of cam)
  53         (with-vertex3d
  54             (location-of cam)
  55             (px py pz pw)
  56           (vertex3d* px py (- pz (* (zoom-speed-of cam))) pw))))
  57
  58
  59 (defparameter *modelview-debug* (make-array 16 :element-type '(single-float)))
  60
  61 ;; (defmethod camera-modelview-matrix ((cam camera))
  62 ;;   (gl:matrix-mode gl:+modelview+)
  63 ;;   (gl:load-identity)
  64 ;;   (with-vector3d
  65 ;;       (vector3d-sum (vertex3d-vector3d  (location-of cam)) (direction-of cam))
  66 ;;         (lx ly lz)
  67 ;;     (with-vector3d
  68 ;;         (vertex3d-vector3d (location-of cam))
  69 ;;         (px py pz)
  70 ;;       (with-vector3d
  71 ;;           (up-of cam)
  72 ;;           (ux uy uz)
  73 ;;         #|        (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) |#
  74 ;;         (glu:look-at
  75 ;;          px py pz
  76 ;;          lx ly lz
  77 ;;          ux uy uz)))))
  78
  79
  80
  81
  82 (def-tuple-op gl-load-matrix44
  83   ((mat matrix44 (e00 e01 e02 e03
  84                   e10 e11 e12 e13
  85                   e20 e21 e22 e23
  86                   e30 e31 e32 e33)))
  87   "Load a matrix44 onto the opengl stack"
  88   (cffi:with-foreign-object (glmat :float 16)
  89       (setf (cffi:mem-aref glmat :float 0) e00)
  90       (setf (cffi:mem-aref glmat :float 1) e10)
  91       (setf (cffi:mem-aref glmat :float 2) e20)
  92       (setf (cffi:mem-aref glmat :float 3) e30)
  93
  94       (setf (cffi:mem-aref glmat :float 4) e01)
  95       (setf (cffi:mem-aref glmat :float 5) e11)
  96       (setf (cffi:mem-aref glmat :float 6) e21)
  97       (setf (cffi:mem-aref glmat :float 7) e31)
  98
  99       (setf (cffi:mem-aref glmat :float 8) e02)
 100       (setf (cffi:mem-aref glmat :float 9) e12)
 101       (setf (cffi:mem-aref glmat :float 10) e22)
 102       (setf (cffi:mem-aref glmat :float 11) e32)
 103
 104       (setf (cffi:mem-aref glmat :float 12) e03)
 105       (setf (cffi:mem-aref glmat :float 13) e13)
 106       (setf (cffi:mem-aref glmat :float 14) e23)
 107       (setf (cffi:mem-aref glmat :float 15) e33)
 108       (gl::%load-matrix-f glmat)))
 109
 110
 111 (defmethod camera-modelview-matrix ((cam camera))
 112   "Return a matrix44 equivalent to glu:look-at"
 113   (gl:matrix-mode gl:+modelview+)
 114   (gl:load-identity)
 115   (gl-load-matrix44
 116    (with-vertex3d
 117        (location-of cam)
 118        (lx ly lz lw)
 119      (with-vector3d
 120          (direction-of cam)
 121          (fx fy fz)
 122        (with-vector3d
 123            (up-of cam)
 124            (ux uy uz)
 125          (with-vector3d
 126              (cross-of cam)
 127              (sx sy sz)
 128            (matrix44* sx  sy   sz   lx
 129                       ux  uy   uz   ly
 130                       fx  fy   fz   lz
 131                       0.0 0.0  0.0  1.0)))))))
 132
 133
 134 (defmacro with-camera (camera &body forms)
 135   `(progn
 136     (camera-modelview-matrix ,camera)
 137     ,@forms))
 138
 139 (defun make-camera () (make-actor 'camera
 140                                   :location (make-vertex3d* 0.0 0.0 -5.0 1.0)
 141                                   :orientation (make-quaternion* 0.0 0.0 0.0 1.0)))
 142
 143 (defparameter *camera* nil)
 144
 145 (defun set-current-camera (cam) (setf *camera* (gethash cam *actors*)))
 146
 147 (defun reset-camera ()
 148   (setf *camera* (make-actor  'camera
 149                               :position (make-vertex3d* 0.0 0.0 -5.0 1.0)
 150                               :orientation (make-quaternion* 0.0 0.0 0.0 1.0))))
 151
 152
 153
 154 ;; camera change far plane function
 155 ;; (make-key-function
 156 ;;     (char-code #\Z)
 157 ;;   (if (eql (glfw:get-key glfw:+key-lshift+) glfw:+press+)
 158 ;;       (incf *z-far* 1.0)
 159 ;;       (decf *z-far* 1.0)))
 160
 161 (defmethod render ((c camera))
 162   (camera-modelview-matrix c)
 163   (gl:get-floatv gl:+modelview-matrix+ *modelview-debug*))
 164