fov.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          fov.lisp
   6 ;;;; Purpose:       Field of view 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 aov-one-dim (focal-length frame-size
  23                                  &key (projection :rectilinear)
  24                                  (magnification 0))
  25   "Returns the angle of view in one dimension. Default is infinity which
  26 has an magnification of 0."
  27   (ecase projection
  28     (:rectilinear
  29      (radians->degrees (* 2 (atan (/ frame-size 2 focal-length
  30                                      (1+ magnification))))))
  31     (:equisolid
  32      (radians->degrees (* 4 (asin (/ frame-size 4 focal-length)))))
  33     (:equidistance
  34      (radians->degrees (/ (* 2 frame-size) focal-length)))
  35     (:orthogonal
  36      (radians->degrees (* 2 (asin (/ frame-size 2 focal-length)))))
  37     (:stereographic
  38      (radians->degrees (* 4 (atan (/ frame-size 4 focal-length)))))
  39     ))
  40
  41
  42 (defun aov (focal-length frame-width frame-height
  43                          &key (projection :rectilinear)
  44                          (magnification 0))
  45   "Returns the angle of field of view for a focal length and frame size.
  46 Default is infinity (magnification 0)"
  47   (values
  48    (aov-one-dim focal-length frame-width :projection projection :magnification magnification)
  49    (aov-one-dim focal-length frame-height :projection projection :magnification magnification)
  50    (aov-one-dim focal-length (diagonal frame-width frame-height)
  51                 :projection projection :magnification magnification)))
  52
  53 (defun gaussian-lens (&key object-distance image-distance focal-length)
  54   (cond
  55    ((and object-distance image-distance (not focal-length))
  56     (float (/ 1 (+ (/ 1 object-distance) (/ 1 image-distance)))))
  57    ((and object-distance focal-length (not image-distance))
  58     (cond
  59      ((= focal-length object-distance)
  60         most-positive-double-float)
  61      ((> focal-length object-distance)
  62       :error)
  63      (t
  64       (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance)))))))
  65    ((and image-distance focal-length (not object-distance))
  66     (cond
  67      ((= focal-length image-distance)
  68         most-positive-double-float)
  69      ((> focal-length image-distance)
  70       :error)
  71      (t
  72       (float (/ 1 (- (/ 1 focal-length) (/ 1 image-distance)))))))
  73    (t
  74     (error "Must specify two, and only two, of the parameters: focal-length, image-distance, object-distance"))))
  75
  76
  77 (defun image-distance-magnification (focal-length magnification)
  78   "Returns the image distance for a focused object at distance using the Gaussian
  79 Lens Equation."
  80   (* focal-length (1+ magnification)))
  81
  82 (defun %fov (focal-length frame-width frame-height object-distance image-distance units
  83                           &optional (projection :rectilinear))
  84   "Returns the field of view (units), magnification ratio, object-distance (units),
  85 and image distance (mm) for a given image (mm) and object distance (mm)."
  86   (unless (numberp image-distance)
  87     (return-from %fov image-distance))
  88   (unless (numberp object-distance)
  89     (return-from %fov object-distance))
  90   (let ((mag (/ image-distance (length->mm object-distance units))))
  91     (multiple-value-bind (aov-width aov-height aov-diagonal)
  92         (aov focal-length frame-width frame-height :projection projection
  93              :magnification mag)
  94       (let* ((d-width (* 2 object-distance (tan (degrees->radians (/ aov-width 2)))))
  95              (d-height (* 2 object-distance (tan (degrees->radians (/ aov-height 2)))))
  96              (d-diagonal (* 2 object-distance (tan (degrees->radians (/ aov-diagonal 2))))))
  97         (values d-width d-height d-diagonal mag object-distance image-distance)))))
  98
  99 (defun fov (focal-length frame-width frame-height
 100                          &key object-distance image-distance magnification
 101                          (units :feet)
 102                          (projection :rectilinear))
 103   (cond
 104    ((and object-distance (not image-distance) (not magnification))
 105     (setq image-distance (gaussian-lens
 106                           :focal-length focal-length
 107                           :object-distance (length->mm object-distance units))))
 108    ((and (not object-distance) image-distance (not magnification))
 109     (setq object-distance (mm->length (gaussian-lens
 110                                        :focal-length focal-length
 111                                        :image-distance image-distance)
 112                                       units)))
 113    ((and (not object-distance) (not image-distance) magnification)
 114     (setf image-distance (image-distance-magnification focal-length magnification)
 115           object-distance (when (numberp image-distance)
 116                             (mm->length (/ image-distance magnification) units))))
 117    (t
 118     (error "Must set one, and only one, of the parameters: image-distance, object-distance, or magnification.")))
 119
 120   (%fov focal-length frame-width frame-height object-distance image-distance units
 121         projection))
 122
 123 (defun aov-format (focal-length format &key (projection :rectilinear))
 124   "Returns the angle of field of view for a focal length and frame size at infinity"
 125   (let ((dim (imager-dimensions format)))
 126     (aov focal-length (car dim) (cdr dim) :projection projection)))
 127
 128 (defun magnification (&key focal-length object-distance image-distance (units :feet))
 129   "Returns the image magnification: the ratio of image size to object size.
 130 focal-length and image-distance are in mm, object-distance is in units"
 131   (when object-distance
 132     (setq object-distance (length->mm object-distance units)))
 133   (cond
 134    ((and (not focal-length) object-distance image-distance)
 135     (if (zerop object-distance)
 136         :error
 137       (float (/ image-distance object-distance))))
 138    ((and focal-length object-distance (not image-distance))
 139     (cond
 140      ((eql object-distance focal-length)
 141       most-positive-double-float)
 142      ((< object-distance focal-length)
 143       :error)
 144      (t
 145       (float (/ focal-length (- object-distance focal-length))))))
 146    ((and focal-length (not object-distance) image-distance)
 147     (cond
 148      ((eql image-distance focal-length)
 149       most-positive-double-float)
 150      ((< image-distance focal-length)
 151       :error)
 152      (t
 153       (float (1- (/ image-distance focal-length))))))
 154    (t
 155     (error "Must set two, and only two, of the parameters: image-distance, object-distance, and focal-length."))))
 156
 157 (defun bellows-factor (focal-length object-distance)
 158   "Returns the bellows factor, the ratio of effective aperature to actual aperture."
 159   (1+ (magnification :focal-length focal-length :object-distance object-distance)))
 160