(in-package #:photo)
-(defun coc (imager-size &key (lpm 5) (minimum-distance 250)
+(defun sort-size (size)
+ "Returns a cons pair with the smaller size first."
+ (if (>= (car size) (cdr size))
+ (cons (cdr size) (car size))
+ (cons (car size) (cdr size))))
+
+(defun print-magnification (imager-size print-size)
+ "Returns the magnification required between an imager and print sizes
+while taking crop into consideration."
+ (setf imager-size (sort-size imager-size))
+ (setf print-size (sort-size print-size))
+ (float (max (/ (car print-size) (car imager-size))
+ (/ (cdr print-size) (cdr print-size)))))
+
+(defun coc (imager-size &key (lpm 5) (minimum-distance 250)
(viewing-distance 250)
(print-size (output-dimensions :8x10in)))
- "Returns circle of confusion in mm and print magnification for a format.
+ "Returns circle of confusion in mm and print magnification for a format.
Default resolving power is 5 lpm at 25cm."
+ (let* ((magnification (print-magnification imager-size print-size))
+ (resolution-factor (/ (* magnification lpm minimum-distance) viewing-distance))
+ (coc (/ 1.0d0 resolution-factor)))
+ (values coc magnification)))
- (let* ((imager-diagonal (diagonal (car imager-size) (cdr imager-size)))
- (print-diagonal (diagonal (car print-size) (cdr print-size)))
- (resolution-factor (/ (* lpm print-diagonal minimum-distance)
- (* imager-diagonal viewing-distance)))
- (coc (/ 1.0d0 resolution-factor))
- (print-magnification (/ print-diagonal imager-diagonal)))
- (values coc print-magnification)))
-
-(defun coc-format (format &key (lpm 5) (minimum-distance 250)
+(defun coc-format (format &key (lpm 5) (minimum-distance 250)
(viewing-distance 250)
(print-size (output-dimensions :8x10in)))
- "Returns circle of confusion in mm and print magnification for a format.
+ "Returns circle of confusion in mm and print magnification for a format.
Default resolving power is 5 lpm at 25cm."
(let* ((format-size (imager-dimensions format))
"Returns lpm and circle of confusion based on pixel size."
(when (and (consp imager) (consp pixels))
(let ((coc-w (float (* 2 (/ (car imager) (car pixels)))))
- (coc-h (float (* 2 (/ (cdr imager) (cdr pixels))))))
+ (coc-h (float (* 2 (/ (cdr imager) (cdr pixels))))))
(values coc-w coc-h (/ 1. coc-w) (/ 1. coc-h)))))
-
+
(defun coc-pixels-format (format)
"Returns circle of confusion based on pixel size."
(coc-pixels (imager-dimensions format) (pixel-dimensions format)))
"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."
- (let* ((aperture (/ focal-length f-stop))
+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))
(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))
"Returns the Depth of Field.
-Input: FOCAL-LENGTH, F-STOP, DISTANCE, CIRCLE-OF-CONFUSION.
+Input: FOCAL-LENGTH, F-STOP, DISTANCE, CIRCLE-OF-CONFUSION.
Output: NEAR-POINT, FAR-POINT, TOTAL-DOF, MAGNIFICATION, BLUR-SIZE-OF-INFINITY-POINT-IN-MM."
(multiple-value-bind (near-point far-point total-dof mag blur)
- (dof-mm focal-length f-stop (length->mm distance units) coc
+ (dof-mm focal-length f-stop (length->mm distance units) coc
:pupil-factor pupil-factor)
(values (mm->length near-point units)
(mm->length far-point units)
(defun mtf-scanner (freq dscan-freq &optional (order 3))
(abs (expt (kmrcl:sinc (* pi (/ freq dscan-freq))) order)))
-(defun freq-mtf-scanner (dscan-freq mtf &optional (order 3))
- (* dscan-freq (/ (asin (* x (exp (/ (log mtf) order)))) pi)))
projects / cl-photo.git / blobdiff