r10421: major development

diff --git a/cl-photo.asd b/cl-photo.asd
index 605300cc8f2b064a560c26140c1ee2dfbe58ae48..da725f3a7e33c1398f4a8bef08a7997b38a38e7b 100644 (file)
--- 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 5327d58ae7b898acd4256667aefc32b4d46ebc54..f663cf8fc98e1651357ea99a0cc8edb70b8ded8f 100755 (executable)
--- 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 (file)
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 (file)
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 (executable)
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 <kevin@rosenberg.net>"))
+    ((: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 &copy; 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 e3793b4969f4af6791880ac09902065d7ba165a5..9cb2486cf719de2373bf9ac45723825423c8c4b0 100755 (executable)
--- 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 6a43317c6131e828c373443bcea690510d79fac1..9b5ac79d1e8acc1216cee3663899ad01ab2e5228 100755 (executable)
--- 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 db350d5ccdc3632e5fa1edfae76be1a125587384..a6dcf1e60f81f0111ba1ecb9b607de7acd35e0ad 100755 (executable)
--- 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
    ))