r10404: Initial import

diff --git a/cl-photo.asd b/cl-photo.asd
new file mode 100644 (file)
index 0000000..666051a
--- /dev/null
+++ b/cl-photo.asd
@@ -0,0 +1,43 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          cl-photo.asd
+;;;; Purpose:       ASDF definition file for Lisp Markup Language Version 2
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  April 2005
+;;;;
+;;;; $Id: cl-photo.asd 8596 2004-02-03 18:32:50Z kevin $
+;;;;
+;;;; 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 #:cl-user)
+(defpackage #:cl-photo-system (:use #:asdf #:cl))
+(in-package #:cl-photo-system)
+
+(defsystem cl-photo
+  :name "cl-photo"
+  :author "Kevin M. Rosenberg <kevin@rosenberg.net>"
+  :version "1.0"
+  :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
+  :licence "GNU General Public License"
+  :description "Lisp Markup Language"
+  :long-description "cl-photo calculates photography values."
+
+  :depends-on (kmrcl)
+  
+  :components
+  ((:file "package")
+   (:file "convert" :depends-on ("package"))
+   (:file "fov" :depends-on ("convert"))
+   (:file "dof" :depends-on ("convert"))
+   ))
+
+(defmethod perform ((o test-op) (c (eql (find-system 'cl-photo))))
+  (operate 'load-op 'cl-photo-tests)
+  (operate 'test-op 'cl-photo-tests))

diff --git a/convert.lisp b/convert.lisp
new file mode 100755 (executable)
index 0000000..34eac1b
--- /dev/null
+++ b/convert.lisp
@@ -0,0 +1,33 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          convert.lisp
+;;;; Purpose:       Conversions functions for cl-photo
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  April 2005
+;;;;
+;;;; $Id: package.lisp 8596 2004-02-03 18:32:50Z kevin $
+;;;;
+;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin Rosenberg.
+;;;; Rights of modification and redistribution are in the LICENSE file.
+;;;;
+;;;; *************************************************************************
+
+(in-package #:photo)
+
+(defconstant +radian->degrees+ (/ 360d0 pi 2))
+(defconstant +inches->mm+ 25.4)
+
+(defun diagonal (x y)
+  (sqrt (+ (* x x) (* y y))))
+
+(defun radians->degrees (r)
+  (* +radian->degrees+ r))
+
+(defun mm->feet (d)
+  (/ d +inches->mm+ 12))
+
+(defun feet->mm (d)
+  (* d 12 +inches->mm+))
+

diff --git a/dof.lisp b/dof.lisp
new file mode 100755 (executable)
index 0000000..27d2939
--- /dev/null
+++ b/dof.lisp
@@ -0,0 +1,52 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          dof.lisp
+;;;; Purpose:       Depth of field functions for cl-photo
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  April 2005
+;;;;
+;;;; $Id: package.lisp 8596 2004-02-03 18:32:50Z kevin $
+;;;;
+;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin Rosenberg.
+;;;; Rights of modification and redistribution are in the LICENSE file.
+;;;;
+;;;; *************************************************************************
+
+(in-package #:photo)
+
+;; Based on http://www.photostuff.co.uk/dofmstr.htm
+
+(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"
+  (let* ((aperature (/ focal-length f-stop))
+         (numerator (* distance coc (- distance focal-length)))
+         (factor-1 (* focal-length aperature))
+         (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)))
+
+

diff --git a/fov.lisp b/fov.lisp
new file mode 100755 (executable)
index 0000000..b4df2b6
--- /dev/null
+++ b/fov.lisp
@@ -0,0 +1,68 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          fov.lisp
+;;;; Purpose:       Field of view functions for cl-photo
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  April 2005
+;;;;
+;;;; $Id: package.lisp 8596 2004-02-03 18:32:50Z kevin $
+;;;;
+;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin Rosenberg.
+;;;; Rights of modification and redistribution are in the LICENSE file.
+;;;;
+;;;; *************************************************************************
+
+(in-package #:photo)
+
+(defun fov-one-dim (focal-length frame-size 
+                                 &key (projection :rectilinear))
+  (ecase projection
+    (:rectilinear
+     (radians->degrees (* 2 (atan (/ frame-size 2 focal-length)))))
+    (:equisolid 
+     (radians->degrees (* 4 (asin (/ frame-size 4 focal-length)))))
+    (:equidistance 
+     (radians->degrees (/ (* 2 frame-size) focal-length)))
+    (:orthogonal
+     (radians->degrees (* 2 (asin (/ frame-size 2 focal-length)))))
+    (:stereographic
+     (radians->degrees (* 4 (atan (/ frame-size 4 focal-length)))))
+    ))
+    
+  
+(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"
+  (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)))
+
+(defun fov-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))
+    ))
+

diff --git a/package.lisp b/package.lisp
new file mode 100755 (executable)
index 0000000..e53e48c
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,29 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          package.lisp
+;;;; Purpose:       Package file for cl-photo
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  April 2005
+;;;;
+;;;; $Id: package.lisp 8596 2004-02-03 18:32:50Z kevin $
+;;;;
+;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin Rosenberg.
+;;;; Rights of modification and redistribution are in the LICENSE file.
+;;;;
+;;;; *************************************************************************
+
+(in-package #:cl-user)
+
+(defpackage #:photo
+  (:use #:common-lisp #:kmrcl)
+  (:export
+
+   ;; fov.lisp
+   #:fov
+   #:fov-format
+
+   ;; dof.lisp
+   ))
+