-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
+;;;; -*-a Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
(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))
: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)
(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)
(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."
(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)
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)))
(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
"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)))
+
(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
))
--- /dev/null
+;;;; -*- 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))
projects / cl-photo.git / commitdiff