dof.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          dof.lisp
   6 ;;;; Purpose:       Depth of field functions for cl-photo
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  April 2005
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; cl-photo users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the GNU General Public License v2
  16 ;;;; (http://www.gnu.org/licenses/gpl.html)
  17 ;;;;
  18 ;;;; *************************************************************************
  19
  20 (in-package #:photo)
  21
  22 (defun sort-size (size)
  23   "Returns a cons pair with the smaller size first."
  24   (if (>= (car size) (cdr size))
  25       (cons (cdr size) (car size))
  26       (cons (car size) (cdr size))))
  27
  28 (defun print-magnification (imager-size print-size)
  29   "Returns the magnification required between an imager and print sizes
  30 while taking crop into consideration."
  31   (setf imager-size (sort-size imager-size))
  32   (setf print-size (sort-size print-size))
  33   (float (max (/ (car print-size) (car imager-size))
  34               (/ (cdr print-size) (cdr print-size)))))
  35
  36 (defun coc (imager-size &key (lpm 5) (minimum-distance 250)
  37                    (viewing-distance 250)
  38                    (print-size (output-dimensions :8x10in)))
  39   "Returns circle of confusion in mm and print magnification for a format.
  40 Default resolving power is 5 lpm at 25cm."
  41   (let* ((magnification (print-magnification imager-size print-size))
  42          (resolution-factor (/ (* magnification lpm minimum-distance) viewing-distance))
  43          (coc (/ 1.0d0 resolution-factor)))
  44     (values coc magnification)))
  45
  46 (defun coc-format (format &key (lpm 5) (minimum-distance 250)
  47                           (viewing-distance 250)
  48                           (print-size (output-dimensions :8x10in)))
  49   "Returns circle of confusion in mm and print magnification for a format.
  50 Default resolving power is 5 lpm at 25cm."
  51
  52   (let* ((format-size (imager-dimensions format))
  53          (format-diagonal (diagonal (car format-size) (cdr format-size)))
  54          (print-diagonal (diagonal (car print-size) (cdr print-size)))
  55          (resolution-factor (/ (* lpm print-diagonal minimum-distance)
  56                                (* format-diagonal viewing-distance)))
  57          (coc (/ 1.0d0 resolution-factor))
  58          (print-magnification (/ print-diagonal format-diagonal)))
  59     (values coc print-magnification)))
  60
  61 (defun coc-pixels (imager pixels)
  62   "Returns lpm and circle of confusion based on pixel size."
  63   (when (and (consp imager) (consp pixels))
  64     (let ((coc-w (float (* 2 (/ (car imager) (car pixels)))))
  65           (coc-h (float (* 2 (/ (cdr imager) (cdr pixels))))))
  66     (values coc-w coc-h (/ 1. coc-w) (/ 1. coc-h)))))
  67
  68 (defun coc-pixels-format (format)
  69   "Returns circle of confusion based on pixel size."
  70   (coc-pixels (imager-dimensions format) (pixel-dimensions format)))
  71
  72 (defun coc-airy (f-stop &optional (wavelength 0.000512))
  73   "Return the circle of confusion based on the airy disk."
  74   (float (/ 1 (rayleigh-limit f-stop wavelength))))
  75
  76 (defun rayleigh-limit (f-stop &optional (wavelength 0.0005))
  77   "Returns the rayleigh limit in line pairs per mm (MTF 9%) as well as the MTF50"
  78   (let ((rayleigh (float (/ 1 1.22 f-stop wavelength))))
  79     (values rayleigh (* 0.46 rayleigh))))
  80
  81 (defun maximum-sharpness-aperture (format &optional (wavelength 0.0005))
  82   (multiple-value-bind (coc-w coc-h lpm-w lpm-h) (coc-pixels-format format)
  83     (declare (ignore coc-w coc-h))
  84     (/ 1. (* 1.22 wavelength (/ (min lpm-w lpm-h) 0.46)))))
  85
  86 (defun dof-mm (focal-length f-stop distance coc &key (pupil-factor 1))
  87   "Returns depth of field based on focal-length, f-stop, distance, and coc.
  88 Six values are returned:
  89 near dof, far dof, total dof, magnification, blur size at infinity (mm).
  90 Circle of confusion can either be a number or keyword designating format.
  91 Reference: http://www.vanwalree.com/optics/dofderivation.html"
  92   (let* ((aperture (/ focal-length f-stop))
  93          (pd (* aperture pupil-factor))
  94          (numerator (* coc (- distance focal-length) (+ focal-length (* pupil-factor (- distance focal-length)))))
  95          (d1 (* pupil-factor coc (- distance focal-length)))
  96          (d2 (* pd focal-length))
  97          (front-dof (/ numerator (+ d1 d2)))
  98          (rear-dof (/ numerator (- d1 d2)))
  99          (mag (float (/ focal-length (- distance focal-length))))
 100          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
 101          (depth (+ front-dof rear-dof)))
 102     (values front-dof rear-dof depth mag infinity-blur-diameter)))
 103
 104 ;; Simplified calculation for symmetric lens
 105 (defun dof-symmetric-mm (focal-length f-stop distance coc)
 106   "Returns depth of field based on focal-length, f-stop, distance, and coc.
 107 Six values are returned:
 108 near dof, far dof, total dof, near point, far point, magnification,
 109 blur size at infinity (mm).
 110 Circle of confusion can either be a number or keyword designating format."
 111   (let* ((aperture (/ focal-length f-stop))
 112          (numerator (* coc (- distance focal-length) (+ focal-length (* (- distance focal-length)))))
 113          (d1 (* coc (- distance focal-length)))
 114          (d2 (* aperture focal-length))
 115          (front-dof (/ numerator (+ d1 d2)))
 116          (rear-dof (/ numerator (- d1 d2)))
 117          (mag (magnification :focal-length focal-length :object-distance distance :units :mm))
 118          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
 119          (depth (+ front-dof rear-dof)))
 120     (values front-dof rear-dof depth mag infinity-blur-diameter)))
 121
 122 (defun dof (focal-length f-stop distance coc &key (units :mm) (pupil-factor 1))
 123   "Returns the Depth of Field.
 124 Input: FOCAL-LENGTH, F-STOP, DISTANCE, CIRCLE-OF-CONFUSION.
 125 Output: NEAR-DOF, FAR-DOF, TOTAL-DOF, MAGNIFICATION, BLUR-SIZE-OF-INFINITY-POINT-IN-MM."
 126   (multiple-value-bind (near-point far-point total-dof mag blur)
 127       (dof-mm focal-length f-stop (length->mm distance units) coc
 128               :pupil-factor pupil-factor)
 129     (values (mm->length near-point units)
 130             (mm->length far-point units)
 131             (mm->length total-dof units)
 132             mag blur)))
 133
 134 (defun hyperfocal (focal-length f-stop coc &key (units :mm))
 135   (mm->length (+ focal-length (/ (* focal-length focal-length) f-stop coc)) units))
 136
 137 (defun effective-aperture (focal-length distance aperture)
 138   (* aperture (bellows-factor focal-length distance)))
 139
 140 (defun mtf-scanner (freq dscan-freq &optional (order 3))
 141   (abs (expt (kmrcl:sinc (* pi (/ freq dscan-freq))) order)))
 142