X-Git-Url: http://git.kpe.io/?p=cl-photo.git;a=blobdiff_plain;f=fov.lisp;h=43d000fa4006e5d80a928d398af975c78e40a21a;hp=572a55b256652cd2e2dad18d4351de7f3fbdd6c1;hb=4860883d5bf05e9e7c83d4f16a001e4edd1d1cb2;hpb=69714017bc3f5e6085872e24790c19fd65d6862b diff --git a/fov.lisp b/fov.lisp index 572a55b..43d000f 100644 --- a/fov.lisp +++ b/fov.lisp @@ -50,36 +50,116 @@ Default is infinity (magnification 0)" (aov-one-dim focal-length (diagonal frame-width frame-height) :projection projection :magnification magnification))) -(defun image-distance (focal-length object-distance) +(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." - (if (= focal-length object-distance) - 0 - (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance)))))) + (* focal-length (1+ magnification))) -(defun fov (focal-length frame-width frame-height object-distance - &key (projection :rectilinear)) - "Returns the field of view and image magnificaion ratio at a given distance." - (let* ((image-distance (image-distance focal-length object-distance)) - (magnification (/ image-distance object-distance))) +(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 magnification) + :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 magnification))))) + (values (mm->length d-width units) + (mm->length d-height units) + (mm->length d-diagonal units) + mag + object-distance + image-distance))))) + +(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" (let ((dim (imager-dimensions format))) (aov focal-length (car dim) (cdr dim) :projection projection))) -(defun magnification (focal-length distance) - "Returns the image magnification: the ratio of image size to objecct size." - (float (/ focal-length (- distance focal-length)))) +(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 distance) +(defun bellows-factor (focal-length object-distance) "Returns the bellows factor, the ratio of effective aperature to actual aperture." - (1+ (magnification focal-length distance))) + (1+ (magnification :focal-length focal-length :object-distance object-distance)))