From 3c1c551f36fe090936bf5d21e7eb65acbcc0d457 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 22 Apr 2005 00:39:21 +0000 Subject: [PATCH] r10439: canera database --- cameras.lisp | 112 +++++++++++++++++++++++++++++++++------------------ cl-photo.asd | 5 ++- dof.lisp | 52 ++++++++++++------------ fov.lisp | 16 ++++++-- package.lisp | 25 +++++++++--- tables.lisp | 62 ++++++++++++++++++++++++++++ 6 files changed, 196 insertions(+), 76 deletions(-) create mode 100755 tables.lisp diff --git a/cameras.lisp b/cameras.lisp index 4d5821a..6e4e74b 100644 --- a/cameras.lisp +++ b/cameras.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*- +;;;; -*-a Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -25,53 +25,85 @@ (width (round (sqrt (* aspect-ratio 1000000 megapixels))))) (cons width (round (/ width aspect-ratio))))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun make-output-format (w h &key (units :inches)) + (let ((name (format nil "~Dx~Din" w h))) + (list :format (kmrcl:ensure-keyword name) + :output (cons (inches->mm w) (inches->mm h)) + :name name + :nicks (list (kmrcl:ensure-keyword (format nil "~Dx~D" w h))))))) -(defun sensor-dimensions (sensor-spec &key (format :aps)) - "Returns the number of pixels for a sensor. +(defparameter +format-db+ + '( + (:format :d2x :make :nikon :pixels (4288 . 2848) :imager (23.7 . 15.6) :name "D2X") + (:format :d100 :make :nikon :pixels (3037 . 2024) :imager (23.7 . 15.6) :name "D100") + (:format :d70 :make :nikon :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D70") + (:format :d70s :make :nikon :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D70s") + (:format :d50 :make :nikon :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D70") + (:format :d1x :make :nikon :pixels (4028 . 1324) :imager (23.7 . 15.6) :name "D1X") + (:format :d2h :make :nikon :pixels (2464 . 1632) :imager (23.3 . 15.5) :name "D2H") + (:format :d2hs :make :nikon :pixels (2464 . 1632) :imager (23.3 . 15.5) :name "D2Hs") + + (:format :300d :make :canon :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "300D") + (:format :10d :make :canon :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "10D") + (:format :d30 :make :canon :pixels (0 . 0) :imager (22.7 . 15.1) :name "D30") + (:format :d60 :make :canon :pixels (0 . 0) :imager (22.7 . 15.1) :name "D60") + (:format :350d :make :canon :pixels (3456 . 2304) :imager (22.2 . 14.8) :name "350D") + (:format :1d :make :canon :pixels (2464 . 1648) :imager (27 . 17.8) :name "1D") + (:format :20d :make :canon :pixels (3456 . 2304) :imager (22.5 . 15) :name "20D") + (:format :1dmkii :make :canon :pixels (3504 . 2336) :imager (28.7 . 19.1) + :name "1D Mark II" :nicks (:1d2 :1dii :1dmkii)) + (:format :1ds :make :canon :pixels (4064 . 3328) :imager (36 . 24) :name "1Ds") + (:format :1dsmkii :make :canon :pixels (4992 . 3328) :imager (36 . 24) + :name "1Ds Mark II" :nicks (:1ds2 :1dsii)) + + (:format :35mm :imager (36 . 24) :name "35mm") + + (:format :6x4.5cm :imager (60 . 45) :name "6x4.5cm" :nicks (:\645)) + (:format :6x6cm :imager (60 . 60) :name "6x6cm" :nicks (:6x6)) + (:format :6x7cm :imager (60 . 70) :name "6x7cm" :nicks (:6x7)) + (:format :6x9cm :imager (60 . 90) :name "6x9cm" :nicks (:6x9)) + (:format :6x12cm :imager (60 . 120) :name "6x12cm" :nicks (:6x12)) + + #.(make-output-format 4 5) + #.(make-output-format 5 7) + #.(make-output-format 8 10) + #.(make-output-format 11 13.75) + #.(make-output-format 11 16.5) + #.(make-output-format 13 16.25) + #.(make-output-format 13 19) + #.(make-output-format 16 20) + #.(make-output-format 16 24) + #.(make-output-format 18 22.5) + #.(make-output-format 18 24) + #.(make-output-format 24 30) + #.(make-output-format 24 36) + )) + +(defun format-match-p (format-spec format) + (when (or (eql format-spec (getf format :format)) + (member format-spec (getf format :nicks))) + t)) + +(defun find-format (format-spec) + (find format-spec +format-db+ :test 'format-match-p)) + +(defun pixel-dimensions (sensor-spec &key (format :35mm)) + "Returns the number of pixels for a format. 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 sensor-spec - ;; nikon - (:d2x (cons 4288 2848)) - (:d100 (cons 3037 2024)) - (:d2h (cons 2464 1632)) - (:d70 (cons 3008 2000)) - - ;; canon - (:1d (cons 2464 1648)) - (:1d2 (cons 3504 2336)) - (:1ds (cons 4064 2704)) - (:1ds2 (cons 4992 3328)) - - )) + (getf (find-format sensor-spec) :pixels)) (number (sensor-dimensions-megapixels format sensor-spec)))) +(defun imager-dimensions (format-spec) + "Returns the imager dimensions in mm of a FORMAT." + (getf (find-format format-spec) :imager)) -(defun format-dimensions (format) - "Returns format dimensions in mm." - (ecase format - (:aps-c (cons 22.7 15.1)) - ((:aps :dx :24x16mm) (cons 24 16)) - ((:35mm :36x24mm) (cons 36 24)) - (:6x4.5cm (cons 60 45)) - ((:6x6 :6x6cm) (cons 60 60)) - ((:6x7 :6x7cm) (cons 60 70)) - ((:6x9 :6x9cm) (cons 60 90)) - ((:4x5 :4x5in) (cons (* 4 +inches->mm+) (* 5 +inches->mm+))) - ((:5x7 :5x7in) (cons (* 5 +inches->mm+) (* 7 +inches->mm+))) - ((:8x10 :8x10in) (cons (* 8 +inches->mm+) (* 10 +inches->mm+))) - (:11x13.75in (cons (* 11 +inches->mm+) (* 13.75 +inches->mm+))) - (:11x16.5in (cons (* 11 +inches->mm+) (* 16.5 +inches->mm+))) - (:13x19in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:16x20in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:16x24in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:18x22.5in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:18x24in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:24x30in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - (:24x36in (cons (* 13 +inches->mm+) (* 19 +inches->mm+))) - )) +(defun output-dimensions (format-spec) + "Returns the output dimensions in mm of a FORMAT." + (getf (find-format format-spec) :output)) diff --git a/cl-photo.asd b/cl-photo.asd index afffe05..51d3993 100644 --- a/cl-photo.asd +++ b/cl-photo.asd @@ -29,13 +29,14 @@ :description "Lisp Markup Language" :long-description "cl-photo calculates photography values." + :depends-on (kmrcl) :components ((:file "package") (:file "convert" :depends-on ("package")) (:file "cameras" :depends-on ("convert")) (:file "fov" :depends-on ("cameras")) - (:file "dof" :depends-on ("cameras")) - )) + (:file "dof" :depends-on ("fov")) + (:file "tables" :depends-on ("dof" "fov")))) (defmethod perform ((o test-op) (c (eql (find-system 'cl-photo)))) (operate 'load-op 'cl-photo-tests) diff --git a/dof.lisp b/dof.lisp index 4dcb7e7..4117c5a 100755 --- a/dof.lisp +++ b/dof.lisp @@ -19,14 +19,27 @@ (in-package #:photo) +(defun coc (imager-size &key (lpm 5) (minimum-distance 250) + (viewing-distance 250) + (print-size (output-dimensions :8x10in))) + "Returns circle of confusion in mm and print magnification for a format. +Default resolving power is 5 lpm at 25cm." + + (let* ((imager-diagonal (diagonal (car imager-size) (cdr imager-size))) + (print-diagonal (diagonal (car print-size) (cdr print-size))) + (resolution-factor (/ (* lpm print-diagonal minimum-distance) + (* imager-diagonal viewing-distance))) + (coc (/ 1.0d0 resolution-factor)) + (print-magnification (/ print-diagonal imager-diagonal))) + (values coc print-magnification))) (defun coc-format (format &key (lpm 5) (minimum-distance 250) (viewing-distance 250) - (print-size (format-dimensions :8x10in))) + (print-size (output-dimensions :8x10in))) "Returns circle of confusion in mm and print magnification for a format. Default resolving power is 5 lpm at 25cm." - (let* ((format-size (format-dimensions format)) + (let* ((format-size (imager-dimensions format)) (format-diagonal (diagonal (car format-size) (cdr format-size))) (print-diagonal (diagonal (car print-size) (cdr print-size))) (resolution-factor (/ (* lpm print-diagonal minimum-distance) @@ -35,21 +48,15 @@ Default resolving power is 5 lpm at 25cm." (print-magnification (/ print-diagonal format-diagonal))) (values coc print-magnification))) -(defun coc-sensor (format nx ny) +(defun coc-pixels (imager pixels) "Returns circle of confusion based on pixel size." - (let* ((dim (format-dimensions format)) - (pixel-width (/ (car dim) nx)) - (pixel-height (/ (cdr dim) ny))) - (values (float (* 2 pixel-width)) - (float (* 2 pixel-height))))) - -(defun coc-sensor-camera (camera &key (format :aps)) - (let ((dim (sensor-dimensions camera :format format))) - (coc-sensor format (car dim) (cdr dim)))) - - - - + (when (and (consp imager) (consp pixels)) + (values (float (* 2 (/ (car imager) (car pixels)))) + (float (* 2 (/ (cdr imager) (cdr pixels))))))) + +(defun coc-pixels-format (format) + "Returns circle of confusion based on pixel size." + (coc-pixels (imager-dimensions format) (pixel-dimensions format))) (defun coc-airy (f-stop) "Return the circle of confusion based on the airy disk." @@ -97,6 +104,9 @@ Pupil factor is the ratio of the exit to enterance pupil diameters." (values near far depth mag infinity-blur-diameter))) (defun dof (focal-length f-stop distance coc &key (units :mm) (pupil-factor 1)) + "Returns the Depth of Field. +Input: FOCAL-LENGTH, F-STOP, DISTANCE, CIRCLE-OF-CONFUSION. +Output: NEAR-POINT, FAR-POINT, TOTAL-DOF, MAGNIFICATION, BLUR-SIZE-OF-INFINITY-POINT-IN-MM." (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) @@ -106,15 +116,7 @@ Pupil factor is the ratio of the exit to enterance pupil diameters." 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))) + (mm->length (+ focal-length (/ (* focal-length focal-length) f-stop coc)) units)) (defun effective-aperture (focal-length distance aperture) (* aperture (bellows-factor focal-length distance))) diff --git a/fov.lisp b/fov.lisp index 9b5ac79..23ca941 100755 --- a/fov.lisp +++ b/fov.lisp @@ -50,14 +50,15 @@ Default is infinity (magnification 0)" (aov-one-dim focal-length (diagonal frame-width frame-height) :projection projection :magnification magnification))) -(defun gaussian-lens (focal-length object-distance) - "Returns the image distance for a focused object at distance." +(defun image-distance (focal-length object-distance) + "Returns the image distance for a focused object at distance using the Gaussian +Lens Equation." (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)) + (let* ((image-distance (image-distance 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 @@ -71,3 +72,12 @@ Default is infinity (magnification 0)" "Returns the angle of field of view for a focal length and frame size at infinity" (let ((dim (format-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 bellows-factor (focal-length distance) + "Returns the bellows factor, the ratio of effective aperature to actual aperture." + (1+ (magnification focal-length distance))) + diff --git a/package.lisp b/package.lisp index a06fd1a..253ca02 100755 --- a/package.lisp +++ b/package.lisp @@ -19,24 +19,37 @@ (in-package #:cl-user) -(defpackage #:photo - (:use #:common-lisp) +(defpackage #:cl-photo + (:use #:common-lisp #:kmrcl) + (:nicknames #:photo) (:export ;; cameras.lisp - #:sensor-dimensions - #:format-dimensions + #:pixel-dimensions + #:imager-dimensions + #:output-dimensions ;; fov.lisp #:aov #:aov-format #:aov-distance - + #:magnification + #:bellows-factor + #:image-distance + ;; dof.lisp + #:coc #:coc-format - #:coc-sensor + #:coc-pixels + #:coc-pixels-format #:coc-airy #:dof #:hyperfocal + #:effective-aperture + + ;; tables.lisp + #:hyperfocal-list + #:hyperfocal-table + #:aov-table )) diff --git a/tables.lisp b/tables.lisp new file mode 100755 index 0000000..c0df801 --- /dev/null +++ b/tables.lisp @@ -0,0 +1,62 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: tables.lisp +;;;; Purpose: Returns tables of values +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: April 2005 +;;;; +;;;; $Id: dof.lisp 10436 2005-04-21 15:36:01Z 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 #:photo) + +(defparameter +f-stops+ '(1.4 2.0 2.8 4.0 5.6 8 11 16 22 32)) +(defparameter +focal-lengths+ '(12 24 35 50 70 85 105 135 200 300 400 500 600)) +(defparameter +distances-feet+ '(0.5 1 3 8 15 25 50 100 200)) + +(defun hyperfocal-list (focal-length coc &key (units :feet)) + (loop for f-stop in +f-stops+ + collect (hyperfocal focal-length f-stop coc :units units))) + +(defun hyperfocal-table (focal-length coc &key (units :feet) (output *standard-output*)) + (loop for f-stop in +f-stops+ + do (format output "~4,1F ~,1F~%" + f-stop (hyperfocal focal-length f-stop coc :units units))) + (values)) + +(defun aov-table (imager &key (output *standard-output*) (projection :rectilinear)) + (let ((imager-dim (etypecase imager + (cons imager) + (symbol (imager-dimensions imager))))) + (loop for focal-length in +focal-lengths+ + do (let ((aov (multiple-value-list (aov focal-length (car imager-dim) (cdr imager-dim) + :projection projection)))) + (format output "~4D ~5,1F ~5,1F ~5,1F~%" + focal-length (nth 0 aov) (nth 1 aov) (nth 2 aov))))) + (values)) + +(defun dof-table (focal-length coc &key (output *standard-output*) (units :feet)) + (let ((distances (mapcar (lambda (mm) (mm->length mm units)) + (mapcar 'feet->mm +distances-feet+)))) + (format output "~&~5A" "") + (dolist (distance distances) + (format output " ~10F" distance)) + (format output "~%") + (dolist (f-stop +f-stops+) + (format output "~5,1F " f-stop) + (dolist (distance distances) + (multiple-value-bind (near far dof mag blur) (dof focal-length f-stop distance coc + :units units) + (when (minusp far) (setq far "Inf")) + (format output "~4,1F/~4,1F " near far))) + (format output "~%"))) + (values)) -- 2.34.1