1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Field of view functions for cl-photo
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: April 2005
12 ;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin M. Rosenberg
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)
18 ;;;; *************************************************************************
22 (defun aov-one-dim (focal-length frame-size
23 &key (projection :rectilinear)
25 "Returns the angle of view in one dimension. Default is infinity which
26 has an magnification of 0."
29 (radians->degrees (* 2 (atan (/ frame-size 2 focal-length
30 (1+ magnification))))))
32 (radians->degrees (* 4 (asin (/ frame-size 4 focal-length)))))
34 (radians->degrees (/ (* 2 frame-size) focal-length)))
36 (radians->degrees (* 2 (asin (/ frame-size 2 focal-length)))))
38 (radians->degrees (* 4 (atan (/ frame-size 4 focal-length)))))
42 (defun aov (focal-length frame-width frame-height
43 &key (projection :rectilinear)
45 "Returns the angle of field of view for a focal length and frame size.
46 Default is infinity (magnification 0)"
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)))
53 (defun gaussian-lens (&key object-distance image-distance focal-length)
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))
59 ((= focal-length object-distance)
60 most-positive-double-float)
61 ((> focal-length object-distance)
64 (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance)))))))
65 ((and image-distance focal-length (not object-distance))
67 ((= focal-length image-distance)
68 most-positive-double-float)
69 ((> focal-length image-distance)
72 (float (/ 1 (- (/ 1 focal-length) (/ 1 image-distance)))))))
74 (error "Must specify two, and only two, of the parameters: focal-length, image-distance, object-distance"))))
77 (defun image-distance-magnification (focal-length magnification)
78 "Returns the image distance for a focused object at distance using the Gaussian
80 (* focal-length (1+ magnification)))
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
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 (mm->length d-width units)
98 (mm->length d-height units)
99 (mm->length d-diagonal units)
104 (defun fov (focal-length frame-width frame-height
105 &key object-distance image-distance magnification
107 (projection :rectilinear))
109 ((and object-distance (not image-distance) (not magnification))
110 (setq image-distance (gaussian-lens
111 :focal-length focal-length
112 :object-distance (length->mm object-distance units))))
113 ((and (not object-distance) image-distance (not magnification))
114 (setq object-distance (mm->length (gaussian-lens
115 :focal-length focal-length
116 :image-distance image-distance)
118 ((and (not object-distance) (not image-distance) magnification)
119 (setf image-distance (image-distance-magnification focal-length magnification)
120 object-distance (when (numberp image-distance)
121 (mm->length (/ image-distance magnification) units))))
123 (error "Must set one, and only one, of the parameters: image-distance, object-distance, or magnification.")))
125 (%fov focal-length frame-width frame-height object-distance image-distance units
128 (defun aov-format (focal-length format &key (projection :rectilinear))
129 "Returns the angle of field of view for a focal length and frame size at infinity"
130 (let ((dim (imager-dimensions format)))
131 (aov focal-length (car dim) (cdr dim) :projection projection)))
133 (defun magnification (&key focal-length object-distance image-distance (units :feet))
134 "Returns the image magnification: the ratio of image size to object size.
135 focal-length and image-distance are in mm, object-distance is in units"
136 (when object-distance
137 (setq object-distance (length->mm object-distance units)))
139 ((and (not focal-length) object-distance image-distance)
140 (if (zerop object-distance)
142 (float (/ image-distance object-distance))))
143 ((and focal-length object-distance (not image-distance))
145 ((eql object-distance focal-length)
146 most-positive-double-float)
147 ((< object-distance focal-length)
150 (float (/ focal-length (- object-distance focal-length))))))
151 ((and focal-length (not object-distance) image-distance)
153 ((eql image-distance focal-length)
154 most-positive-double-float)
155 ((< image-distance focal-length)
158 (float (1- (/ image-distance focal-length))))))
160 (error "Must set two, and only two, of the parameters: image-distance, object-distance, and focal-length."))))
162 (defun bellows-factor (focal-length object-distance)
163 "Returns the bellows factor, the ratio of effective aperature to actual aperture."
164 (1+ (magnification :focal-length focal-length :object-distance object-distance)))