Update domain name to kpe.io

[cl-photo.git] / dof.lisp

diff --git a/dof.lisp b/dof.lisp
index f1cd7b245a71b07bd95e1afdcfcf81a5bc15bcce..d8677d307ad3b40d873f6f4180e66c023f8456a4 100644 (file)
--- a/dof.lisp
+++ b/dof.lisp
@@ -87,8 +87,10 @@ Default resolving power is 5 lpm at 25cm."
   "Returns depth of field based on focal-length, f-stop, distance, and coc.
 Six values are returned:
 near point, far point, total dof, magnification, blur size at infinity (mm).
-Circle of confusion can either be a number or keyword designating format."
+Circle of confusion can either be a number or keyword designating format.
+Reference: http://www.vanwalree.com/optics/dofderivation.html"
   (let* ((aperture (/ focal-length f-stop))
+         (hyperfocal (hyperfocal focal-length f-stop coc))
          (numerator-1 (* (- pupil-factor 1) (- distance focal-length)
                          coc focal-length))
          (numerator-2 (* pupil-factor aperture focal-length distance))
@@ -96,30 +98,42 @@ Circle of confusion can either be a number or keyword designating format."
          (denominator-2 (* pupil-factor aperture focal-length))
          (near (/ (+ numerator-1 numerator-2)
                   (+ denominator-1 denominator-2)))
-         (far (/ (- numerator-1 numerator-2)
-                 (- denominator-1 denominator-2)))
+         (far (when (/= denominator-1 denominator-2)
+                (/ (- numerator-1 numerator-2)
+                   (- denominator-1 denominator-2))))
          (mag (float (/ focal-length (- distance focal-length))))
          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
-         (depth (- far near)))
+         (depth (when far (- far near))))
+    (when (or (>= distance hyperfocal)
+               (and (null far) (>= distance (* hyperfocal 0.99))))
+      (setq near (/ hyperfocal 2)
+            far most-positive-short-float
+            depth most-positive-short-float))
     (values near far depth mag infinity-blur-diameter)))
 
 ;; Simplified calculation for symmetric lens
 (defun dof-symmetric-mm (focal-length f-stop distance coc)
   "Returns depth of field based on focal-length, f-stop, distance, and coc.
 Six values are returned:
-near dof, far dof, total dof, near point, far point, magnification,
+near point, far point, total dof, near point, far point, magnification,
 blur size at infinity (mm).
-Circle of confusion can either be a number or keyword designating format.
-Pupil factor is the ratio of the exit to enterance pupil diameters."
+Circle of confusion can either be a number or keyword designating format."
   (let* ((aperture (/ focal-length f-stop))
+         (hyperfocal (hyperfocal focal-length f-stop coc))
          (numerator (* distance coc (- distance focal-length)))
          (factor-1 (* focal-length aperture))
          (factor-2 (* coc (- distance focal-length)))
          (near (- distance (/ numerator (+ factor-1 factor-2))))
-         (far (+ distance (/ numerator (- factor-1 factor-2))))
-         (mag (magnification focal-length distance))
+         (far (when (/= factor-1 factor-2)
+                (+ distance (/ numerator (- factor-1 factor-2)))))
+         (mag (magnification :focal-length focal-length :object-distance distance :units :mm))
          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
-         (depth (- far near)))
+         (depth (when far (- far near))))
+    (when (or (>= distance hyperfocal)
+               (and (null far) (>= distance (* hyperfocal 0.99))))
+      (setq near (/ hyperfocal 2)
+            far most-positive-short-float
+            depth most-positive-short-float))
     (values near far depth mag infinity-blur-diameter)))
 
 (defun dof (focal-length f-stop distance coc &key (units :mm) (pupil-factor 1))