transforms.lisp

   1
   2
   3 (in-package :cl-tuples)
   4
   5 (defun make-translation (x y z)
   6   (let ((result (make-matrix-44)))
   7     (with-matrix44 result
   8                    (e00 e01 e02 e03
   9                     e10 e11 e12 e13
  10                     e20 e21 e22 e23
  11                     e30 e31 e32 e33)
  12                    (setf e03 x)
  13                    (setf e13 y)
  14                    (setf e23 z))))
  15
  16
  17
  18 (defun make-scaling (x y z)
  19   (let ((result (make-matrix-44)))
  20     (with-matrix44 result
  21                    (e00 e01 e02 e03
  22                     e10 e11 e12 e13
  23                     e20 e21 e22 e23
  24                     e30 e31 e32 e33)
  25                    (setf e00 x)
  26                    (setf e11 y)
  27                    (setf e22 z))))
  28
  29 (defun make-rotation (theta :key axis)
  30   (let
  31       ((s (sin theta))
  32        (c (cos theta))
  33        (result (make-matrix-44)))
  34     (with-matrix44
  35      result
  36      (e00 e01 e02 e03
  37       e10 e11 e12 e13
  38       e20 e21 e22 e23
  39       e30 e31 e32 e33)
  40      (ecase axis
  41             (:x ((setf e11 c)
  42                  (setf e22 c)
  43                  (setf e21 (- s))
  44                  (setf e12 s)))
  45             (:y ((setf e00 c)
  46                  (setf e22 c)
  47                  (setf e02 (- s))
  48                  (setf e20 s))
  49             (:z ((setf e00 c)
  50                  (setf e11 c)
  51                  (setf e01 s)
  52                  (setf e10 (-s )))))))))
  53
  54 (defun make-perspective (fov near far)
  55   (let
  56       ((s (sin (* 0.5 fov)))
  57        (c (cos (* 0.5 fov)))
  58        (q (/ s (- 1 (/ near far)))))
  59 (with-matrix44
  60      result
  61      (e00 e01 e02 e03
  62       e10 e11 e12 e13
  63       e20 e21 e22 e23
  64       e30 e31 e32 e33)
  65      (setf e00 c)
  66      (setf e11 c)
  67      (setf e22 q)
  68      (setf e32 s)
  69      (setf e23 (- (* q near))))))
  70
  71
  72