(in-package #:photo)
(defconstant +radian->degrees+ (/ 360d0 pi 2))
-(defconstant +inches->mm+ 25.4)
+(defconstant +inches->mm+ 25.4d0)
+(declaim (inline diagonal))
(defun diagonal (x y)
(sqrt (+ (* x x) (* y y))))
+(declaim (inline radians->degrees))
(defun radians->degrees (r)
(* +radian->degrees+ r))
+(declaim (inline degrees->radians))
+(defun degrees->radians (r)
+ (/ r +radian->degrees+))
+
+(declaim (inline mm->feet))
(defun mm->feet (d)
(/ d +inches->mm+ 12))
+(declaim (inline feet->mm))
(defun feet->mm (d)
(* d 12 +inches->mm+))
+(declaim (inline inches->mm))
+(defun inches->mm (d)
+ (* d +inches->mm+))
+
+(defun format-dimensions (format)
+ "Returns format dimensions in mm."
+ (ecase format
+ (:aps-c (cons 22.7 15.1))
+ ((:aps :dx) (cons 24 16))
+ ((:35 :35mm) (cons 36 24))
+ ((:645 :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+)))
+ ))
;; Based on http://www.photostuff.co.uk/dofmstr.htm
+(defun coc-format (format &key (lpm 5) (minimum-distance 250)
+ (viewing-distance 250)
+ (print-size (format-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))
+ (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)
+ (* format-diagonal viewing-distance)))
+ (coc (/ 1.0d0 resolution-factor))
+ (print-magnification (/ print-diagonal format-diagonal)))
+ (values coc print-magnification)))
+
+(defun coc-sensor (format nx ny)
+ "Returns circle of confusion based on pixel size."
+ (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))))
+
+(defun coc-sensor-camera (camera &key (format :aps))
+ (let ((dim (sensor-dimensions camera :format format)))
+ (coc-sensor format (car dim) (cdr dim))))
+
+(defun sensor-dimensions-megapixels (format megapixels)
+ (let* ((dim (format-dimensions format))
+ (aspect-ratio (/ (car dim) (cdr dim)))
+ (width (round (sqrt (* aspect-ratio 1000000 megapixels)))))
+ (cons width (round (/ width aspect-ratio)))))
+
+(defun sensor-dimensions (camera &key (format :aps))
+ (etypecase camera
+ (keyword
+ (ecase camera
+ ;; nikon
+ (:d2x (cons 4288 2848))
+ (:d2x (cons 2484 1242))
+ (:d70 (cons 3008 2000))
+
+ ;; canon
+ (:1d (cons 2464 1648))
+ (:1d2 (cons 3504 2336))
+ (:1ds (cons 4064 2704))
+ (:1ds2 (cons 4992 3328))
+
+ ))
+ (number
+ (sensor-dimensions-megapixels format camera))))
+
+(defun coc-airy-disk (f-stop)
+ "Return the circle of confusion based on the airy disk."
+ (let ((airy (/ f-stop 1500)))
+ (coerce (* 2 airy) 'float)))
+
(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"
+near dof, far dof, total dof, near point, far point.
+Circle of confusion can either be a number or keyword designating format."
(let* ((aperature (/ focal-length f-stop))
(numerator (* distance coc (- distance focal-length)))
(factor-1 (* focal-length aperature))
(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))))
(fov-one-dim focal-length (diagonal frame-width frame-height)
:projection projection)))
+(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 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))
- ))
-
+ (let ((dim (format-dimensions format)))
+ (fov focal-length (car dim) (cdr dim) :projection projection)))
projects / cl-photo.git / commitdiff