+(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.
+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)))
+
+(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.
+Default resolving power is 5 lpm at 25cm."
+
+ (let* ((format-size (imager-dimensions format))
+ (format-diagonal (diagonal (car format-size) (cdr format-size)))
+ (print-diagonal (diagonal (car print-size) (cdr print-size)))
+ (resolution-factor (/ (* lpm print-diagonal minimum-distance)
+ (* format-diagonal viewing-distance)))
+ (coc (/ 1.0d0 resolution-factor))
+ (print-magnification (/ print-diagonal format-diagonal)))
+ (values coc print-magnification)))
+
+(defun coc-pixels (imager pixels)
+ "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))))))
+ (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)))
+
+(defun coc-airy (f-stop &optional (wavelength 0.000512))
+ "Return the circle of confusion based on the airy disk."
+ (float (/ 1 (rayleigh-limit f-stop wavelength))))
+
+(defun rayleigh-limit (f-stop &optional (wavelength 0.0005))
+ "Returns the rayleigh limit in line pairs per mm (MTF 9%) as well as the MTF50"
+ (let ((rayleigh (float (/ 1 1.22 f-stop wavelength))))
+ (values rayleigh (* 0.46 rayleigh))))