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 coc (imager-size &key (lpm 5) (minimum-distance 250)
  23                    (viewing-distance 250)
  24                    (print-size (output-dimensions :8x10in)))
  25   "Returns circle of confusion in mm and print magnification for a format.
  26 Default resolving power is 5 lpm at 25cm."
  27
  28   (let* ((imager-diagonal (diagonal (car imager-size) (cdr imager-size)))
  29          (print-diagonal (diagonal (car print-size) (cdr print-size)))
  30          (resolution-factor (/ (* lpm print-diagonal minimum-distance)
  31                                (* imager-diagonal viewing-distance)))
  32          (coc (/ 1.0d0 resolution-factor))
  33          (print-magnification (/ print-diagonal imager-diagonal)))
  34     (values coc print-magnification)))
  35
  36 (defun coc-format (format &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
  42   (let* ((format-size (imager-dimensions format))
  43          (format-diagonal (diagonal (car format-size) (cdr format-size)))
  44          (print-diagonal (diagonal (car print-size) (cdr print-size)))
  45          (resolution-factor (/ (* lpm print-diagonal minimum-distance)
  46                                (* format-diagonal viewing-distance)))
  47          (coc (/ 1.0d0 resolution-factor))
  48          (print-magnification (/ print-diagonal format-diagonal)))
  49     (values coc print-magnification)))
  50
  51 (defun coc-pixels (imager pixels)
  52   "Returns lpm and circle of confusion based on pixel size."
  53   (when (and (consp imager) (consp pixels))
  54     (let ((coc-w (float (* 2 (/ (car imager) (car pixels)))))
  55           (coc-h (float (* 2 (/ (cdr imager) (cdr pixels))))))
  56     (values coc-w coc-h (/ 1. coc-w) (/ 1. coc-h)))))
  57
  58 (defun coc-pixels-format (format)
  59   "Returns circle of confusion based on pixel size."
  60   (coc-pixels (imager-dimensions format) (pixel-dimensions format)))
  61
  62 (defun coc-airy (f-stop &optional (wavelength 0.000512))
  63   "Return the circle of confusion based on the airy disk."
  64   (float (/ 1 (rayleigh-limit f-stop wavelength))))
  65
  66 (defun rayleigh-limit (f-stop &optional (wavelength 0.0005))
  67   "Returns the rayleigh limit in line pairs per mm (MTF 9%) as well as the MTF50"
  68   (let ((rayleigh (float (/ 1 1.22 f-stop wavelength))))
  69     (values rayleigh (* 0.46 rayleigh))))
  70
  71 (defun maximum-sharpness-aperture (format &optional (wavelength 0.0005))
  72   (multiple-value-bind (coc-w coc-h lpm-w lpm-h) (coc-pixels-format format)
  73     (/ 1. (* 1.22 wavelength (/ (min lpm-w lpm-h) 0.46)))))
  74
  75 (defun dof-mm (focal-length f-stop distance coc &key (pupil-factor 1))
  76   "Returns depth of field based on focal-length, f-stop, distance, and coc.
  77 Six values are returned:
  78 near point, far point, total dof, magnification, blur size at infinity (mm).
  79 Circle of confusion can either be a number or keyword designating format."
  80   (let* ((aperture (/ focal-length f-stop))
  81          (numerator-1 (* (- pupil-factor 1) (- distance focal-length)
  82                          coc focal-length))
  83          (numerator-2 (* pupil-factor aperture focal-length distance))
  84          (denominator-1 (* pupil-factor coc (- distance focal-length)))
  85          (denominator-2 (* pupil-factor aperture focal-length))
  86          (near (/ (+ numerator-1 numerator-2)
  87                   (+ denominator-1 denominator-2)))
  88          (far (/ (- numerator-1 numerator-2)
  89                  (- denominator-1 denominator-2)))
  90          (mag (float (/ focal-length (- distance focal-length))))
  91          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
  92          (depth (- far near)))
  93     (values near far depth mag infinity-blur-diameter)))
  94
  95 ;; Simplified calculation for symmetric lens
  96 (defun dof-symmetric-mm (focal-length f-stop distance coc)
  97   "Returns depth of field based on focal-length, f-stop, distance, and coc.
  98 Six values are returned:
  99 near dof, far dof, total dof, near point, far point, magnification,
 100 blur size at infinity (mm).
 101 Circle of confusion can either be a number or keyword designating format.
 102 Pupil factor is the ratio of the exit to enterance pupil diameters."
 103   (let* ((aperture (/ focal-length f-stop))
 104          (numerator (* distance coc (- distance focal-length)))
 105          (factor-1 (* focal-length aperture))
 106          (factor-2 (* coc (- distance focal-length)))
 107          (near (- distance (/ numerator (+ factor-1 factor-2))))
 108          (far (+ distance (/ numerator (- factor-1 factor-2))))
 109          (mag (magnification focal-length distance))
 110          (infinity-blur-diameter (/ (* mag focal-length) f-stop))
 111          (depth (- far near)))
 112     (values near far depth mag infinity-blur-diameter)))
 113
 114 (defun dof (focal-length f-stop distance coc &key (units :mm) (pupil-factor 1))
 115   "Returns the Depth of Field.
 116 Input: FOCAL-LENGTH, F-STOP, DISTANCE, CIRCLE-OF-CONFUSION.
 117 Output: NEAR-POINT, FAR-POINT, TOTAL-DOF, MAGNIFICATION, BLUR-SIZE-OF-INFINITY-POINT-IN-MM."
 118   (multiple-value-bind (near-point far-point total-dof mag blur)
 119       (dof-mm focal-length f-stop (length->mm distance units) coc
 120               :pupil-factor pupil-factor)
 121     (values (mm->length near-point units)
 122             (mm->length far-point units)
 123             (mm->length total-dof units)
 124             mag blur)))
 125
 126 (defun hyperfocal (focal-length f-stop coc &key (units :mm))
 127   (mm->length (+ focal-length (/ (* focal-length focal-length) f-stop coc)) units))
 128
 129 (defun effective-aperture (focal-length distance aperture)
 130   (* aperture (bellows-factor focal-length distance)))