camera.lisp

   1
   2 (in-package :lambdamundo)
   3
   4 ;; camera
   5
   6
   7 (def-tuple-class camera
   8   (:tuples
   9    ((position :type vertex3d)
  10     (orientation :type quaternion))
  11    :slots
  12    ((speed :initform 0.0 :accessor speed-of :type single-float)
  13     (zoom-speed-of :initform 0.0 :accessor zoom-speed-of :type single-float))))
  14
  15
  16 (defmethod up-of ((cam camera))
  17   "Return a tuple vector representing the up axis of the camera."
  18   (quaternion-transform-vector3d
  19    (vector3d* 0.0 1.0 0.0)
  20    (orientation-of cam)))
  21
  22 (defmethod direction-of ((cam camera))
  23   "Return a tuple vector representing the z axis of the camera."
  24   (quaternion-transform-vector3d
  25    (vector3d* 0.0 0.0 1.0)
  26    (orientation-of cam)))
  27
  28 (defmethod cross-of ((cam camera))
  29   "Return a tuple vector representing the x axis of the camera."
  30   (quaternion-transform-vector3d
  31    (vector3d* 1.0 0.0 0.0)
  32    (orientation-of cam)))
  33
  34 (def-tuple-op update-vertex
  35     ((p vertex3d (x y z w))
  36      (v vector3d (vx vy vz))
  37      (delta single-float))
  38       "Move the given vertex in the direction of the given vector, uniformly scaled by delta."
  39       (:return vertex3d
  40                (vertex3d*
  41                 (+ x (* vx delta))
  42                 (+ y (* vy delta))
  43                 (+ z (* vz delta))
  44                 w)))
  45
  46 (defmethod move ((cam camera) dx dy)
  47   "Move the camera by dx in the horizontal plane and by dy in the vertical"
  48   (setf (position-of cam)
  49         (update-vertex (position-of cam) (direction-of cam)  (* dy (- (speed-of cam)))))
  50   (setf (position-of cam) (update-vertex (position-of cam) (cross-of cam) (* dx  (speed-of cam)))))
  51
  52 (defmethod rotate ((cam camera) dx dy)
  53   (setf (orientation-of cam)
  54         (quaternion-product
  55          (orientation-of cam)
  56          (angle-axis-quaternion
  57           (angle-axis* 0.0 0.0 1.0  (* *mouse-sensitivity* dy)))))
  58   (setf (orientation-of cam)
  59         (with-vector3d
  60             (cross-of cam)
  61             (cx cy cz)
  62           (quaternion-product
  63            (orientation-of cam)
  64            (angle-axis-quaternion
  65             (angle-axis* cx cy cz  (* *mouse-sensitivity* dy)))))))
  66
  67 (defmethod zoom ((cam camera) dz)
  68   (setf (position-of cam)
  69         (with-vertex3d
  70             (position-of cam)
  71             (px py pz pw)
  72           (vertex3d* px py (- pz (* (zoom-speed-of cam))) pw))))
  73
  74
  75 (defmethod camera-modelview-matrix ((cam camera))
  76   (gl:matrix-mode gl:+modelview+)
  77   (gl:load-identity)
  78   (with-vector3d
  79       (vector3d-sum (vertex3d-vector3d  (position-of cam)) (direction-of cam))
  80         (lx ly lz)
  81     (with-vector3d
  82         (vertex3d-vector3d (position-of cam))
  83         (px py pz)
  84       (with-vector3d
  85           (up-of cam)
  86           (ux uy uz)
  87         #|        (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) |#
  88         (glu:look-at
  89          px py pz
  90          lx ly lz
  91          ux uy uz)))))
  92
  93 (defmacro with-camera (camera &body forms)
  94   `(progn
  95     (camera-modelview-matrix ,camera)
  96     ,@forms))
  97
  98 (defparameter *camera* (make-instance 'camera
  99                                       :position (make-vertex3d* 0.0 0.0 -5.0 1.0)
 100                                       :orientation (make-quaternion* 0.0 0.0 0.0 1.0)))
 101
 102 (defun reset-camera ()
 103   (setf *camera* (make-instance 'camera
 104                                 :position (make-vertex3d* 0.0 0.0 -5.0 1.0)
 105                                 :orientation (make-quaternion* 0.0 0.0 0.0 1.0))))
 106
 107 ;; camera change far plane function
 108 ;; (make-key-function
 109 ;;     (char-code #\Z)
 110 ;;   (if (eql (glfw:get-key glfw:+key-lshift+) glfw:+press+)
 111 ;;       (incf *z-far* 1.0)
 112 ;;       (decf *z-far* 1.0)))