From afb52c66a55ede18c0dc3b9ca8ee4cf0e7570937 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 19 Apr 2005 21:57:00 +0000 Subject: [PATCH] r10421: major development --- cl-photo.asd | 2 - convert.lisp | 22 ++++++++++ doc/Makefile | 10 +++++ doc/make.lisp | 7 +++ doc/readme.lml | 66 ++++++++++++++++++++++++++++ dof.lisp | 114 ++++++++++++++++++++++++++++++++----------------- fov.lisp | 57 +++++++++++++++---------- package.lisp | 10 ++++- 8 files changed, 222 insertions(+), 66 deletions(-) create mode 100644 doc/Makefile create mode 100644 doc/make.lisp create mode 100755 doc/readme.lml diff --git a/cl-photo.asd b/cl-photo.asd index 605300c..da725f3 100644 --- a/cl-photo.asd +++ b/cl-photo.asd @@ -29,8 +29,6 @@ :description "Lisp Markup Language" :long-description "cl-photo calculates photography values." - :depends-on (kmrcl) - :components ((:file "package") (:file "convert" :depends-on ("package")) diff --git a/convert.lisp b/convert.lisp index 5327d58..f663cf8 100755 --- a/convert.lisp +++ b/convert.lisp @@ -46,6 +46,28 @@ (defun inches->mm (d) (* d +inches->mm+)) +(declaim (inline mm->inches)) +(defun mm->inches (d) + (/ d +inches->mm+)) + +(defun length->mm (d units) + "Convert a length in units to mm." + (ecase units + (:mm d) + (:inches (inches->mm d)) + (:feet (* 12 (inches->mm d))) + (:yards (* 36 (inches->mm d))) + (:meters (* 1000 d)))) + +(defun mm->length (d units) + "Convert a number of mm to units." + (ecase units + (:mm d) + (:inches (mm->inches d)) + (:feet (/ (mm->inches d) 12)) + (:yards (/ (mm->inches d) 36)) + (:meters (/ d 1000)))) + (defun format-dimensions (format) "Returns format dimensions in mm." (ecase format diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000..d19391d --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,10 @@ +.PHONY: site all clean + +all: site + +site: + clisp -i "`pwd`/make.lisp" + +clean: + @rm -f *~ \#*\# .\#* memdump + diff --git a/doc/make.lisp b/doc/make.lisp new file mode 100644 index 0000000..b94dbd5 --- /dev/null +++ b/doc/make.lisp @@ -0,0 +1,7 @@ +#+cmu (setq ext:*gc-verbose* nil) + +(asdf:operate 'asdf:load-op 'lml2) +(in-package #:lml2) +(let ((cwd (parse-namestring (lml-cwd)))) + (process-dir cwd)) +(lml-quit) diff --git a/doc/readme.lml b/doc/readme.lml new file mode 100755 index 0000000..8465ab7 --- /dev/null +++ b/doc/readme.lml @@ -0,0 +1,66 @@ +;;; -*- Mode: Lisp -*- + +(in-package #:lml2) + +(html-file-page ("readme") + (html + (:head + (:title "CL-PHOTO README") + ((:meta :http-equiv "Content-Type" :content "text/html; charset=iso-8859-1")) + ((:meta :name "Copyright" :content "Kevin Rosenberg 2002 ")) + ((:meta :name "description" :content "CL-Photo Documentation")) + ((:meta :name "author" :content "Kevin Rosenberg")) + ((:meta :name "keywords" :content "Common Lisp, Photography, Calculator"))) + + (:body + (:h1 "CL-Photo Documentation") + (:h2 "Overview") + (:p + ((:a :href "http://files.b9.com/cl-photo/") "CL-Photo") + " is a Common Lisp package for calculation functions used in photography. " + ((:a :href "http://files.b9.com/cl-photo") "CL-Photo") + " is written and Copyright © by " + ((:a :href "mailto:kevin@rosenberg.net") "Kevin Rosenberg") + ".") + + (:p + "The home page for CL-Photo is " + ((:a :href "http://files.b9.com/cl-photo") "http://files.b9.com/cl-photo") + ".") + + (:h2 "Prerequisites") + (:ul + (:li ((:a :href "http://cliki.net/asdf") "ASDF")) + + (:h2 "References") + (:ul + (:li + ((:a :href "http://solo.colorado.edu/~walawend/TwilightLandscapes/DoF_article.shtml") + "http://solo.colorado.edu/~walawend/TwilightLandscapes/DoF_article.shtml") + ((:a :href "http://www.vanwalree.com/optics/dofderivation.html") + "http://www.vanwalree.com/optics/dofderivation.html") + ((:a :href "http://www.photo.net/learn/optics/lensFAQ") + "http://www.photo.net/learn/optics/lensFAQ") + ((:a :href "http://www.mhohner.de/formulas.php") + "http://www.mhohner.de/formulas.php") + ) + )) + + (:h2 "Installation") + (:p + "The easiest way to install CL-Photo is to use the " + ((:a :href "http://www.debian.org/") "Debian") + " GNU/Linux operating system. You can then use the command " + (:tt "apt-get install cl-photo") + " to automatically download and install the CL-Photo package.") + (:p + "On a non-Debian system, you need to have " + ((:a :href "http://cclan.sourceforge.net/") "ASDF") + " installed to load the system definition file. You will need to change the source + pathname in the system file to match the location where you have installed CL-Photo.") + + (:h2 "Usage") + (:p + "Currently, there is no documentation on the functions provided by CL-Photo. However, the source code is instructive.") + ))) + diff --git a/dof.lisp b/dof.lisp index e3793b4..9cb2486 100755 --- a/dof.lisp +++ b/dof.lisp @@ -19,7 +19,6 @@ (in-package #:photo) -;; Based on http://www.photostuff.co.uk/dofmstr.htm (defun coc-format (format &key (lpm 5) (minimum-distance 250) (viewing-distance 250) @@ -41,8 +40,8 @@ Default resolving power is 5 lpm at 25cm." (let* ((dim (format-dimensions format)) (pixel-width (/ (car dim) nx)) (pixel-height (/ (cdr dim) ny))) - (values (coerce (* 2 pixel-width) 'float) - (coerce (* 2 pixel-height) 'float)))) + (values (float (* 2 pixel-width)) + (float (* 2 pixel-height))))) (defun coc-sensor-camera (camera &key (format :aps)) (let ((dim (sensor-dimensions camera :format format))) @@ -54,13 +53,20 @@ Default resolving power is 5 lpm at 25cm." (width (round (sqrt (* aspect-ratio 1000000 megapixels))))) (cons width (round (/ width aspect-ratio))))) -(defun sensor-dimensions (camera &key (format :aps)) - (etypecase camera + +(defun sensor-dimensions (sensor-spec &key (format :aps)) + "Returns the number of pixels for a sensor. +CAMERA-SPEC is either a keyword designating the camera or +the number of megapixels of the sensor. +FORMAT should be defined if the CAMERA-SPEC is the number of megapixels +so the proper aspect ratio is used." + (etypecase sensor-spec (keyword - (ecase camera + (ecase sensor-spec ;; nikon (:d2x (cons 4288 2848)) - (:d2x (cons 2484 1242)) + (:d100 (cons 3037 2024)) + (:d2h (cons 2464 1632)) (:d70 (cons 3008 2000)) ;; canon @@ -71,42 +77,72 @@ Default resolving power is 5 lpm at 25cm." )) (number - (sensor-dimensions-megapixels format camera)))) + (sensor-dimensions-megapixels format sensor-spec)))) -(defun coc-airy-disk (f-stop) +(defun coc-airy (f-stop) "Return the circle of confusion based on the airy disk." (let ((airy (/ f-stop 1500))) - (coerce (* 2 airy) 'float))) + (float (* 2 airy)))) -(defun dof (focal-length f-stop distance coc) - "Returns depth of field as fives values: -near dof, far dof, total dof, near point, far point. +(defun dof-mm (focal-length f-stop distance coc &key (pupil-factor 1)) + "Returns depth of field based on focal-length, f-stop, distance, and coc. +Six values are returned: +near dof, far dof, total dof, near point, far point, magnification, +blur size at infinity (mm). Circle of confusion can either be a number or keyword designating format." - (let* ((aperature (/ focal-length f-stop)) + (let* ((aperture (/ focal-length f-stop)) + (numerator-1 (* (- pupil-factor 1) (- distance focal-length) + coc focal-length)) + (numerator-2 (* pupil-factor aperture focal-length distance)) + (denominator-1 (* pupil-factor coc (- distance focal-length))) + (denominator-2 (* pupil-factor aperture focal-length)) + (near (/ (+ numerator-1 numerator-2) + (+ denominator-1 denominator-2))) + (far (/ (- numerator-1 numerator-2) + (- denominator-1 denominator-2))) + (mag (float (/ focal-length (- distance focal-length)))) + (infinity-blur-diameter (/ (* mag focal-length) f-stop)) + (depth (- far near))) + (values near far depth mag infinity-blur-diameter))) + +;; Simplified calculation for symmetric lens +(defun dof-symmetric-mm (focal-length f-stop distance coc) + "Returns depth of field based on focal-length, f-stop, distance, and coc. +Six values are returned: +near dof, far dof, total dof, near point, far point, magnification, +blur size at infinity (mm). +Circle of confusion can either be a number or keyword designating format. +Pupil factor is the ratio of the exit to enterance pupil diameters." + (let* ((aperture (/ focal-length f-stop)) (numerator (* distance coc (- distance focal-length))) - (factor-1 (* focal-length aperature)) + (factor-1 (* focal-length aperture)) (factor-2 (* coc (- distance focal-length))) - (near (/ numerator (+ factor-1 factor-2))) - (far (/ numerator (- factor-1 factor-2))) - (depth (+ far near))) - (values near far depth (- distance near) (+ distance far)))) - -(defun dof-feet (focal-length f-stop distance coc) - (multiple-value-bind (near-dof far-dof total-dof near-point far-point) - (dof focal-length f-stop (feet->mm distance) coc) - (values (mm->feet near-dof) (mm->feet far-dof) (mm->feet total-dof) - (mm->feet near-point) (mm->feet far-point)))) - -(defun dof-meters (focal-length f-stop distance coc) - (multiple-value-bind (near-dof far-dof total-dof near-point far-point) - (dof focal-length f-stop (* 1000 distance) coc) - (values (* 0.001 near-dof) (* 0.001 far-dof) (* 0.001 total-dof) - (* 0.001 near-point) (* 0.001 far-point)))) - -(defun hyperfocal (focal-length f-stop coc) - (+ focal-length (/ (* focal-length focal-length) (* f-stop coc)))) - -(defun hyperfocal-feet (focal-length f-stop coc) - (mm->feet (hyperfocal focal-length f-stop coc))) - - + (near (- distance (/ numerator (+ factor-1 factor-2)))) + (far (+ distance (/ numerator (- factor-1 factor-2)))) + (mag (magnification focal-length distance)) + (infinity-blur-diameter (/ (* mag focal-length) f-stop)) + (depth (- far near))) + (values near far depth mag infinity-blur-diameter))) + +(defun dof (focal-length f-stop distance coc &key (units :mm) (pupil-factor 1)) + (multiple-value-bind (near-point far-point total-dof mag blur) + (dof-mm focal-length f-stop (length->mm distance units) coc + :pupil-factor pupil-factor) + (values (mm->length near-point units) + (mm->length far-point units) + (mm->length total-dof units) + mag blur))) + +(defun hyperfocal (focal-length f-stop coc &key (units :mm)) + (mm->length + (+ focal-length (/ (* focal-length focal-length) f-stop coc)) + units)) + +(defun magnification (focal-length distance) + (float (/ focal-length (- distance focal-length)))) + +(defun bellows-factor (focal-length distance) + (1+ (magnification focal-length distance))) + +(defun effective-aperture (focal-length distance aperture) + (* aperture (bellows-factor focal-length distance))) \ No newline at end of file diff --git a/fov.lisp b/fov.lisp index 6a43317..9b5ac79 100755 --- a/fov.lisp +++ b/fov.lisp @@ -19,11 +19,15 @@ (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 @@ -35,28 +39,35 @@ )) -(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 fov-distance (focal-length frame-width frame-height distance - &key (projection :rectilinear)) - "Returns the field of view and image magnificaion ratio at a given distance. -NOTE: magnification assumes that distance is in the same units as frame size: mm" - (multiple-value-bind (fov-width fov-height fov-diagonal) - (fov focal-length frame-width frame-height :projection projection) - (let* ((d-width (* distance (sin (degrees->radians fov-width)))) - (d-height (* distance (sin (degrees->radians fov-height)))) - (d-diagonal (* distance (sin (degrees->radians fov-diagonal)))) - (mag (/ frame-width d-width))) - (values d-width d-height d-diagonal mag)))) +(defun gaussian-lens (focal-length object-distance) + "Returns the image distance for a focused object at distance." + (float (/ 1 (- (/ 1 focal-length) (/ 1 object-distance))))) + +(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 (gaussian-lens focal-length object-distance)) + (magnification (/ image-distance object-distance))) + (multiple-value-bind (aov-width aov-height aov-diagonal) + (aov focal-length frame-width frame-height :projection projection + :magnification magnification) + (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))))) -(defun fov-format (focal-length format &key (projection :rectilinear)) +(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 (format-dimensions format))) - (fov focal-length (car dim) (cdr dim) :projection projection))) + (aov focal-length (car dim) (cdr dim) :projection projection))) diff --git a/package.lisp b/package.lisp index db350d5..a6dcf1e 100755 --- a/package.lisp +++ b/package.lisp @@ -24,9 +24,15 @@ (:export ;; fov.lisp - #:fov - #:fov-format + #:aov + #:aov-format + #:aov-distance ;; dof.lisp + #:coc-format + #:coc-sensor + #:coc-airy + #:dof + #:hyperfocal )) -- 2.34.1