From: Kevin M. Rosenberg Date: Tue, 3 May 2005 04:35:51 +0000 (+0000) Subject: r10508: add close-up function X-Git-Tag: v0.13~19 X-Git-Url: http://git.kpe.io/?p=cl-photo.git;a=commitdiff_plain;h=cd49c092c9ede840170af3301b9296cec4b0be3e r10508: add close-up function --- diff --git a/debian/changelog b/debian/changelog index 23f9328..2dfa31a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,7 +2,7 @@ cl-photo (0.8-1) unstable; urgency=low * New upstream - -- Kevin M. Rosenberg Thu, 28 Apr 2005 13:35:22 -0600 + -- Kevin M. Rosenberg Mon, 2 May 2005 21:30:49 -0600 cl-photo (0.7-1) unstable; urgency=low diff --git a/fov.lisp b/fov.lisp index 2b01e82..211820a 100644 --- a/fov.lisp +++ b/fov.lisp @@ -50,26 +50,30 @@ Default is infinity (magnification 0)" (aov-one-dim focal-length (diagonal frame-width frame-height) :projection projection :magnification magnification))) -(defun gaussian-lens (&key object-distance image-distance focal-length) +(defun gaussian-lens (&key object-distance image-distance focal-length (units :mm)) + "object-distance is in units. image-distance and focal-length are in mm." (cond ((and object-distance image-distance (not focal-length)) - (float (/ 1 (+ (/ 1 object-distance) (/ 1 image-distance))))) + ;; Return focal length + (float (/ 1 (+ (/ 1 (length->mm object-distance units)) (/ 1 image-distance))))) ((and object-distance focal-length (not image-distance)) + ;; Return image distance (cond - ((= focal-length object-distance) + ((= focal-length (length->mm object-distance units)) most-positive-double-float) - ((> focal-length object-distance) + ((> focal-length (length->mm object-distance units)) :error) (t - (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance))))))) + (float (/ 1 (- (/ 1 focal-length) (/ 1 (length->mm object-distance units)))))))) ((and image-distance focal-length (not object-distance)) + ;; Return 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))))))) + (mm->length (float (/ 1 (- (/ 1 focal-length) (/ 1 image-distance)))) units)))) (t (error "Must specify two, and only two, of the parameters: focal-length, image-distance, object-distance")))) @@ -104,12 +108,13 @@ and image distance (mm) for a given image (mm) and object distance (mm)." ((and object-distance (not image-distance) (not magnification)) (setq image-distance (gaussian-lens :focal-length focal-length - :object-distance (length->mm object-distance units)))) + :object-distance object-distance + :units 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))) + (setq object-distance (gaussian-lens + :focal-length focal-length + :image-distance image-distance + :units units))) ((and (not object-distance) (not image-distance) magnification) (setf image-distance (image-distance-magnification focal-length magnification) object-distance (when (numberp image-distance) @@ -154,6 +159,51 @@ focal-length and image-distance are in mm, object-distance is in units" (t (error "Must set two, and only two, of the parameters: image-distance, object-distance, and focal-length.")))) +(defun close-up (&key focal-length object-distance image-distance magnification (units :feet) &aux bellows-factor) + "Computes the parameters for focusing closer than infinity. +Requires two, and only two, of the input parameters. +Returns: focal-length object-distance image-distance magnification bellows-factor." + (cond + ((and focal-length object-distance (not image-distance) (not magnification)) + (setq magnification (magnification :focal-length focal-length + :object-distance object-distance + :units units)) + (setq image-distance (gaussian-lens :focal-length focal-length + :object-distance object-distance + :units units))) + ((and focal-length (not object-distance) image-distance (not magnification)) + (setq magnification (magnification :focal-length focal-length + :image-distance image-distance + :units units)) + (setq object-distance (gaussian-lens :focal-length focal-length + :image-distance image-distance + :units units))) + ((and (not focal-length) object-distance image-distance (not magnification)) + (setq magnification (magnification :object-distance object-distance + :image-distance image-distance + :units units)) + (setq focal-length (gaussian-lens :object-distance object-distance + :image-distance image-distance + :units units))) + ((and focal-length (not object-distance) (not image-distance) magnification) + (setq image-distance (image-distance-magnification focal-length magnification)) + (setq object-distance (gaussian-lens :focal-length focal-length + :image-distance image-distance + :units units))) + ((and (not focal-length) object-distance (not image-distance) magnification) + (setq image-distance (* magnification (length->mm object-distance units))) + (setq focal-length (gaussian-lens :image-distance image-distance + :object-distance object-distance + :units units))) + ((and (not focal-length) (not object-distance) image-distance magnification) + (setq object-distance (mm->length (float (/ image-distance magnification)) units)) + (setq focal-length (gaussian-lens :image-distance image-distance + :object-distance object-distance + :units units))) + (t + (error "Must set two, and only two input parameters: focal-length, image-distance, object-distance, magnifcation."))) + (values focal-length object-distance image-distance magnification (1+ magnification))) + (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))) diff --git a/package.lisp b/package.lisp index a549fdc..5b28e2d 100644 --- a/package.lisp +++ b/package.lisp @@ -39,7 +39,8 @@ #:magnification #:bellows-factor #:gaussian-lens - + #:close-up + ;; dof.lisp #:coc #:coc-format diff --git a/tests.lisp b/tests.lisp index 73e009b..3f1c57c 100644 --- a/tests.lisp +++ b/tests.lisp @@ -86,3 +86,51 @@ :mag.6 (magnification :image-distance 100 :object-distance (cl-photo::mm->feet 100) :units :feet) 1) +(def-numeric-test + :cu.1 (close-up :focal-length 65 :magnification 5 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.2 (close-up :focal-length 65 :object-distance 78 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.3 (close-up :focal-length 65 :image-distance 390 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.4 (close-up :object-distance 78 :image-distance 390 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.5 (close-up :object-distance 78 :magnification 5 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.6 (close-up :image-distance 390 :magnification 5 :units :mm) + 65 78 390 5 6) + +(def-numeric-test + :cu.7 (close-up :focal-length 65 :magnification 5 :units :feet) + 65 0.2559055 390 5 6) + +(def-numeric-test + :cu.8 (close-up :focal-length 65 :object-distance 0.2559055 :units :feet) + 65 0.2559055 390 5 6) + +(def-numeric-test + :cu.9 (close-up :focal-length 65 :image-distance 390 :units :feet) + 65 0.2559055 390 5 6) + +(def-numeric-test + :cu.10 (close-up :object-distance 0.2559055 :image-distance 390 :units :feet) + 65 0.2559055 390 5 6) + +(def-numeric-test + :cu.11 (close-up :object-distance 0.2559055 :magnification 5 :units :feet) + 65 0.2559055 390 5 6) + +(def-numeric-test + :cu.12 (close-up :image-distance 390 :magnification 5 :units :feet) + 65 0.2559055 390 5 6) +