Update domain name to kpe.io
[cl-photo.git] / cameras.lisp
index 4d5821a2c44b722173da7dfe233261569bd68bef..9edbcd3615c20dba4789b6ad9143804007581a80 100644 (file)
 (in-package #:photo)
 
 (defun sensor-dimensions-megapixels (format megapixels)
-  (let* ((dim (format-dimensions format))
+  (let* ((dim (imager-dimensions format))
          (aspect-ratio (/ (car dim) (cdr dim)))
          (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~D~A" w h
+                        (ecase units
+                          (:inches "in")
+                          (:mm "mm")
+                          (:cm "cm")
+                          (:m "m")
+                          (:feet "ft")))))
+      (list :format (kmrcl:ensure-keyword name)
+            :output (cons (length->mm w units) (length->mm h units))
+            :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 :dcs3 :make "Canon" :pixels (1268 . 1012) :imager (20.5 . 16.4) :name "EOS DCS1")
+    (:format :dcs1 :make "Canon" :pixels (3060 . 2036) :imager (27.6 . 18.4) :name "EOS DCS3")
+    (:format :d2000 :make "Canon" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "EOS D2000")
+    (:format :d6000 :make "Canon" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "EOS D6000")
+    (:format :d30 :make "Canon" :pixels (2160 . 1440) :imager (22 . 14.9) :name "D30")
+    (:format :d60 :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "D60")
+    (:format :10d :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "10D")
+    (:format :20d :make "Canon" :pixels (3456 . 2304) :imager (22.5 . 15) :name "20D")
+    (:format :5d :make "Canon" :pixels (4368 . 2912) :imager (35.8 . 23.9) :name "5D")
+    (:format :300d :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "300D")
+    (: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 :1dmkii :make "Canon" :pixels (3504 . 2336) :imager (28.7 . 19.1)
+     :name "1D Mark II" :nicks (:1d2 :1dii :1dmkii))
+    (:format :1dmkiii :make "Canon" :pixels (3888 . 2592) :imager (28.1 . 18.7)
+     :name "1D Mark III" :nicks (:1d3 :1diii :1dmkiii))
+    (: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 :1dsmkiii :make "Canon" :pixels (5616 . 3744) :imager (36 . 24)
+    :name "1Ds Mark III" :nicks (:1ds3 :1dsiii))
+    (:format :g7 :make "Canon" :pixels (3648 . 2736) :imager (7.2 . 5.3)
+             :name "PowerShot G7")
+    (:format :ndigital :make "Contax" :pixels (3040 . 2008) :imager (36 . 24)
+     :name "N Digital")
+
+    (:format :s1pro :make "FujiFilm" :pixels (3040 . 2016) :imager (23 . 15.5)
+     :name "FinePix S1 Pro")
+    (:format :s2pro :make "FujiFilm" :pixels (4256 . 2848) :imager (23 . 15.5)
+     :name "FinePix S2 Pro")
+    (:format :s3pro :make "FujiFilm" :pixels (4256 . 2848) :imager (23 . 15.5)
+     :name "FinePix S2 Pro")
+
+    (:format :dcs100 :make "Kodak" :pixels (1280 . 1024) :imager (20.5 . 16.4) :name "DCS 100")
+    (:format :dcs200 :make "Kodak" :pixels (1524 . 1008) :imager (14 . 9.3) :name "DCS 200")
+    (:format :dcs315 :make "Kodak" :pixels (1520 . 1008) :imager nil :name "DCS 315")
+    (:format :dcs330 :make "Kodak" :pixels (2008 . 1504) :imager nil :name "DCS 330")
+    (:format :dcs420 :make "Kodak" :pixels (1524 . 1012) :imager (14 . 9.3) :name "DCS 420")
+    (:format :dcs460 :make "Kodak" :pixels (3060 . 2036) :imager (27.6 . 18.4) :name "DCS 460")
+    (:format :dcs520 :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 520")
+    (:format :dcs560 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 560")
+    (:format :dcs620 :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 620")
+    (:format :dcs660 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 660")
+    (:format :dcs720x :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 720x")
+    (:format :dcs760 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 760")
+    (:format :dcsslr/n :make "Kodak" :pixels (4500 . 3000) :imager (36 . 24) :name "DCS SLR/n")
+    (:format :dcsslr/c :make "Kodak" :pixels (4500 . 3000) :imager (36 . 24) :name "DCS SLR/n")
+    (:format :dcs14n :make "Kodak" :pixels (4536 . 3024) :imager (36 . 24) :name "DCS 14n")
+
+    (:format :maxxum7d :make "Konica Minolta" :pixels (3008 . 2000) :imager (23.5 . 15.5)
+     :name "Maxxum 7D")
+
+    (:format :d1 :make "Nikon" :pixels (2000 . 1312) :imager (23.7 . 15.6) :name "D1")
+    (:format :d1x :make "Nikon" :pixels (4028 . 1324) :imager (23.7 . 15.6) :name "D1X")
+    (:format :d100 :make "Nikon" :pixels (3037 . 2024) :imager (23.7 . 15.6) :name "D100")
+    (:format :d200 :make "Nikon" :pixels (3872 . 2592) :imager (23.6 . 15.8) :name "D200")
+    (:format :d300 :make "Nikon" :pixels (4288 . 2848) :imager (23.6 . 15.8) :name "D300")
+    (:format :d50 :make "Nikon" :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D50")
+    (: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 :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 :d2x :make "Nikon" :pixels (4288 . 2848) :imager (23.7 . 15.6) :name "D2X")
+    (:format :d3 :make "Nikon" :pixels (4256 . 2832) :imager (36 . 23.9) :name "D3")
+
+    (:format :cp5900 :make "Nikon" :pixels (2592 . 1944) :imager (7.18 . 5.32) :name "Coolpix 5900")
+    (:format :cp7900 :make "Nikon" :pixels (3072 . 2304) :imager (7.18 . 5.32) :name "Coolpix 7900")
+    (:format :cp8800 :make "Nikon" :pixels (3264 . 2448) :imager (8.8 . 6.6) :name "Coolpix 8800")
+
+    (:format :*ist-d :make "Pentax" :pixels (3008 . 2008) :imager (36 . 24)
+     :name "*ist D")
+    (:format :*ist-ds :make "Pentax" :pixels (3008 . 2008) :imager (36 . 24)
+     :name "*ist DS")
+
+    (:format :sd9 :make "Sigma" :pixels (2268 . 1512) :imager (20.7 . 13.8)
+     :name "SD9")
+    (:format :sd10 :make "Sigma" :pixels (2268 . 1512) :imager (20.7 . 13.8)
+     :name "SD10")
+
+    (:format :1/1.8in :imager (7.18 . 5.32) :name "1/1.8\"")
+    (:format :dx :imager (24 . 16) :name "DX")
+    (: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 sort-formats (formats)
+  (sort formats
+        (lambda (a b)
+          (block nil
+            (cond
+              ((and (null (getf a :make)) (getf b :make))
+               (return nil))
+              ((and (getf a :make) (null (getf b :make)))
+               (return t))
+              ((string-lessp (getf a :make) (getf b :make))
+               (return t))
+              ((string-greaterp (getf a :make) (getf b :make))
+               (return nil)))
+            (when (and (getf a :name) (getf b :name))
+              (cond
+                ((string-lessp (getf a :name) (getf b :name))
+                 (return t))
+                ((string-greaterp (getf a :name) (getf b :name))
+                 (return nil))))))))
+
+(defvar *digital-cameras*
+  (sort-formats (loop for format in +format-db+
+                      when (getf format :pixels)
+                      collect format)))
+
+(defvar *cameras*
+  (sort-formats (loop for format in +format-db+
+                      when (getf format :imager)
+                      collect format)))
+
+
+(defun format-match-p (format-spec format)
+  (let ((key (ensure-keyword format-spec)))
+    (when (or (eql key (getf format :format))
+              (member key (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))
-
-       ))
+    ((or string keyword)
+     (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 pixel-size (format-spec)
+  "Return pixel size in micrometers."
+  (let ((pixel-dim (pixel-dimensions format-spec))
+        (imager-dim (imager-dimensions format-spec)))
+    (when (and pixel-dim imager-dim)
+      (values (* 1000 (/ (car imager-dim) (car pixel-dim)))
+              (* 1000 (/ (cdr imager-dim) (cdr pixel-dim)))))))
+
+(defun output-dimensions (format-spec)
+  "Returns the output dimensions in mm of a FORMAT."
+  (getf (find-format format-spec) :output))