X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=fov.lisp;h=2b01e8293c35d223b8e4cfbd8836551277e65024;hb=5e38a707983711121425bcb9f5f6a88baf832bfc;hp=b4df2b633943e40a28818c657dbf36f3cd42c7a2;hpb=0c8ab037b4267adebe22e07249e0e36fe7ca5f17;p=cl-photo.git diff --git a/fov.lisp b/fov.lisp old mode 100755 new mode 100644 index b4df2b6..2b01e82 --- a/fov.lisp +++ b/fov.lisp @@ -7,20 +7,27 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: April 2005 ;;;; -;;;; $Id: package.lisp 8596 2004-02-03 18:32:50Z kevin $ +;;;; $Id$ ;;;; -;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin Rosenberg. -;;;; Rights of modification and redistribution are in the LICENSE file. +;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin M. Rosenberg +;;;; +;;;; cl-photo users are granted the rights to distribute and use this software +;;;; as governed by the terms of the GNU General Public License v2 +;;;; (http://www.gnu.org/licenses/gpl.html) ;;;; ;;;; ************************************************************************* (in-package #:photo) -(defun fov-one-dim (focal-length frame-size - &key (projection :rectilinear)) +(defun aov-one-dim (focal-length frame-size + &key (projection :rectilinear) + (magnification 0)) + "Returns the angle of view in one dimension. Default is infinity which +has an magnification of 0." (ecase projection (:rectilinear - (radians->degrees (* 2 (atan (/ frame-size 2 focal-length))))) + (radians->degrees (* 2 (atan (/ frame-size 2 focal-length + (1+ magnification)))))) (:equisolid (radians->degrees (* 4 (asin (/ frame-size 4 focal-length))))) (:equidistance @@ -32,37 +39,122 @@ )) -(defun fov (focal-length frame-width frame-height - &key (projection :rectilinear)) - "Returns the angle of field of view for a focal length and frame size at infinity" +(defun aov (focal-length frame-width frame-height + &key (projection :rectilinear) + (magnification 0)) + "Returns the angle of field of view for a focal length and frame size. +Default is infinity (magnification 0)" (values - (fov-one-dim focal-length frame-width :projection projection) - (fov-one-dim focal-length frame-height :projection projection) - (fov-one-dim focal-length (diagonal frame-width frame-height) - :projection projection))) + (aov-one-dim focal-length frame-width :projection projection :magnification magnification) + (aov-one-dim focal-length frame-height :projection projection :magnification magnification) + (aov-one-dim focal-length (diagonal frame-width frame-height) + :projection projection :magnification magnification))) + +(defun gaussian-lens (&key object-distance image-distance focal-length) + (cond + ((and object-distance image-distance (not focal-length)) + (float (/ 1 (+ (/ 1 object-distance) (/ 1 image-distance))))) + ((and object-distance focal-length (not image-distance)) + (cond + ((= focal-length object-distance) + most-positive-double-float) + ((> focal-length object-distance) + :error) + (t + (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance))))))) + ((and image-distance focal-length (not object-distance)) + (cond + ((= focal-length image-distance) + most-positive-double-float) + ((> focal-length image-distance) + :error) + (t + (float (/ 1 (- (/ 1 focal-length) (/ 1 image-distance))))))) + (t + (error "Must specify two, and only two, of the parameters: focal-length, image-distance, object-distance")))) + + +(defun image-distance-magnification (focal-length magnification) + "Returns the image distance for a focused object at distance using the Gaussian +Lens Equation." + (* focal-length (1+ magnification))) + +(defun %fov (focal-length frame-width frame-height object-distance image-distance units + &optional (projection :rectilinear)) + "Returns the field of view (units), magnification ratio, object-distance (units), +and image distance (mm) for a given image (mm) and object distance (mm)." + (unless (numberp image-distance) + (return-from %fov image-distance)) + (unless (numberp object-distance) + (return-from %fov object-distance)) + (let ((mag (/ image-distance (length->mm object-distance units)))) + (multiple-value-bind (aov-width aov-height aov-diagonal) + (aov focal-length frame-width frame-height :projection projection + :magnification mag) + (let* ((d-width (* 2 object-distance (tan (degrees->radians (/ aov-width 2))))) + (d-height (* 2 object-distance (tan (degrees->radians (/ aov-height 2))))) + (d-diagonal (* 2 object-distance (tan (degrees->radians (/ aov-diagonal 2)))))) + (values d-width d-height d-diagonal mag object-distance image-distance))))) -(defun fov-format (focal-length format &key (projection :rectilinear)) +(defun fov (focal-length frame-width frame-height + &key object-distance image-distance magnification + (units :feet) + (projection :rectilinear)) + (cond + ((and object-distance (not image-distance) (not magnification)) + (setq image-distance (gaussian-lens + :focal-length focal-length + :object-distance (length->mm object-distance units)))) + ((and (not object-distance) image-distance (not magnification)) + (setq object-distance (mm->length (gaussian-lens + :focal-length focal-length + :image-distance image-distance) + units))) + ((and (not object-distance) (not image-distance) magnification) + (setf image-distance (image-distance-magnification focal-length magnification) + object-distance (when (numberp image-distance) + (mm->length (/ image-distance magnification) units)))) + (t + (error "Must set one, and only one, of the parameters: image-distance, object-distance, or magnification."))) + + (%fov focal-length frame-width frame-height object-distance image-distance units + projection)) + +(defun aov-format (focal-length format &key (projection :rectilinear)) "Returns the angle of field of view for a focal length and frame size at infinity" - (ecase format - (:aps-c - (fov focal-length 22.7 15.1 :projection projection)) - (:aps - (fov focal-length 24 18 :projection projection)) - (:35mm - (fov focal-length 36 24 :projection projection)) - (:4.5x6 - (fov focal-length 45 60 :projection projection)) - (:6x6 - (fov focal-length 60 60 :projection projection)) - (:6x7 - (fov focal-length 60 70 :projection projection)) - (:6x9 - (fov focal-length 60 90 :projection projection)) - (:4x5 - (fov focal-length (* 4 +inches->mm+) (* 5 +inches->mm+) - :projection projection)) - (:8x10 - (fov focal-length (* 8 +inches->mm+) (* 10 +inches->mm+) - :projection projection)) - )) + (let ((dim (imager-dimensions format))) + (aov focal-length (car dim) (cdr dim) :projection projection))) + +(defun magnification (&key focal-length object-distance image-distance (units :feet)) + "Returns the image magnification: the ratio of image size to object size. +focal-length and image-distance are in mm, object-distance is in units" + (when object-distance + (setq object-distance (length->mm object-distance units))) + (cond + ((and (not focal-length) object-distance image-distance) + (if (zerop object-distance) + :error + (float (/ image-distance object-distance)))) + ((and focal-length object-distance (not image-distance)) + (cond + ((eql object-distance focal-length) + most-positive-double-float) + ((< object-distance focal-length) + :error) + (t + (float (/ focal-length (- object-distance focal-length)))))) + ((and focal-length (not object-distance) image-distance) + (cond + ((eql image-distance focal-length) + most-positive-double-float) + ((< image-distance focal-length) + :error) + (t + (float (1- (/ image-distance focal-length)))))) + (t + (error "Must set two, and only two, of the parameters: image-distance, object-distance, and focal-length.")))) + +(defun bellows-factor (focal-length object-distance) + "Returns the bellows factor, the ratio of effective aperature to actual aperture." + (1+ (magnification :focal-length focal-length :object-distance object-distance)))