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 (def-tuple-op gl-load-matrix44
  82   ((mat matrix44 (e00 e01 e02 e03
  83                   e10 e11 e12 e13
  84                   e20 e21 e22 e23
  85                   e30 e31 e32 e33)))
  86   "Load a matrix44 onto the opengl stack"
  87   (cffi:with-foreign-object (glmat :float 16)
  88     (dotimes (i 16)
  89       (setf (cffi:mem-aref glmat :float i) (matrix44-aref mat i)))
  90     (gl::%load-matrix-f glmat)))
  91
  92
  93 (defmethod camera-modelview-matrix ((cam camera))
  94   "Return a matrix44 equivalent to glu:look-at"
  95   (gl:matrix-mode gl:+modelview+)
  96   (gl:load-identity)
  97   (gl-load-matrix44
  98    (with-vertex3d
  99        (location-of cam)
 100        (lx ly lz lw)
 101      (with-vector3d
 102          (direction-of cam)
 103          (fx fy fz)
 104        (with-vector3d
 105            (up-of cam)
 106            (ux uy uz)
 107          (with-vector3d
 108              (cross-of cam)
 109              (sx sy sz)
 110            (matrix44* sx  sy   sz   lx
 111                     ux  uy   uz   ly
 112                     fx  fy   fz   lw
 113                     0.0 0.0  0.0  1.0)))))))
 114
 115
 116
 117 (defmacro with-camera (camera &body forms)
 118   `(progn
 119     (camera-modelview-matrix ,camera)
 120     ,@forms))
 121
 122 (defun make-camera () (make-instance 'camera
 123                                       :location (make-vertex3d* 0.0 0.0 -5.0 1.0)
 124                                       :orientation (make-quaternion* 0.0 0.0 0.0 1.0)))
 125
 126 (defparameter *camera* nil)
 127
 128 (defun set-current-camera (cam) (setf *camera* cam))
 129
 130 (defun reset-camera ()
 131   (setf *camera* (make-instance 'camera
 132                                 :position (make-vertex3d* 0.0 0.0 -5.0 1.0)
 133                                 :orientation (make-quaternion* 0.0 0.0 0.0 1.0))))
 134
 135
 136
 137 ;; camera change far plane function
 138 ;; (make-key-function
 139 ;;     (char-code #\Z)
 140 ;;   (if (eql (glfw:get-key glfw:+key-lshift+) glfw:+press+)
 141 ;;       (incf *z-far* 1.0)
 142 ;;       (decf *z-far* 1.0)))
 143
 144 (defmethod render ((c camera))
 145   (camera-modelview-matrix c)
 146   (gl:get-floatv gl:+modelview-matrix+ *modelview-debug*))