cameras.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          cameras.lisp
   6 ;;;; Purpose:       Camera-specific data for cl-photo
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  April 2005
   9 ;;;;
  10 ;;;; $Id: dof.lisp 10421 2005-04-19 21:57:00Z kevin $
  11 ;;;;
  12 ;;;; This file, part of cl-photo, is Copyright (c) 2005 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; cl-photo users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the GNU General Public License v2
  16 ;;;; (http://www.gnu.org/licenses/gpl.html)
  17 ;;;;
  18 ;;;; *************************************************************************
  19
  20 (in-package #:photo)
  21
  22 (defun sensor-dimensions-megapixels (format megapixels)
  23   (let* ((dim (imager-dimensions format))
  24          (aspect-ratio (/ (car dim) (cdr dim)))
  25          (width (round (sqrt (* aspect-ratio 1000000 megapixels)))))
  26     (cons width (round (/ width aspect-ratio)))))
  27
  28 (eval-when (:compile-toplevel :load-toplevel :execute)
  29   (defun make-output-format (w h &key (units :inches))
  30     (let ((name (format nil "~Dx~Din" w h)))
  31       (list :format (kmrcl:ensure-keyword name)
  32             :output (cons (inches->mm w) (inches->mm h))
  33             :name name
  34             :nicks (list (kmrcl:ensure-keyword (format nil "~Dx~D" w h)))))))
  35
  36 (defparameter +format-db+
  37   '(
  38     (:format :dcs3 :make "Canon" :pixels (1268 . 1012) :imager (20.5 . 16.4) :name "EOS DCS1")
  39     (:format :dcs1 :make "Canon" :pixels (3060 . 2036) :imager (27.6 . 18.4) :name "EOS DCS3")
  40     (:format :d2000 :make "Canon" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "EOS D2000")
  41     (:format :d6000 :make "Canon" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "EOS D6000")
  42     (:format :d30 :make "Canon" :pixels (2160 . 1440) :imager (22 . 14.9) :name "D30")
  43     (:format :d60 :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "D60")
  44     (:format :10d :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "10D")
  45     (:format :20d :make "Canon" :pixels (3456 . 2304) :imager (22.5 . 15) :name "20D")
  46     (:format :300d :make "Canon" :pixels (3072 . 2048) :imager (22.7 . 15.1) :name "300D")
  47     (:format :350d :make "Canon" :pixels (3456 . 2304) :imager (22.2 . 14.8) :name "350D")
  48     (:format :1d :make "Canon" :pixels (2464 . 1648) :imager (27 . 17.8) :name "1D")
  49     (:format :1dmkii :make "Canon" :pixels (3504 . 2336) :imager (28.7 . 19.1)
  50      :name "1D Mark II" :nicks (:1d2 :1dii :1dmkii))
  51     (:format :1ds :make "Canon" :pixels (4064 . 3328) :imager (36 . 24) :name "1Ds")
  52     (:format :1dsmkii :make "Canon" :pixels (4992 . 3328) :imager (36 . 24)
  53     :name "1Ds Mark II" :nicks (:1ds2 :1dsii))
  54
  55     (:format :ndigital :make "Contax" :pixels (3040 . 2008) :imager (36 . 24)
  56      :name "N Digital")
  57
  58     (:format :s1pro :make "FujiFilm" :pixels (3040 . 2016) :imager (23 . 15.5)
  59      :name "FinePix S1 Pro")
  60     (:format :s2pro :make "FujiFilm" :pixels (4256 . 2848) :imager (23 . 15.5)
  61      :name "FinePix S2 Pro")
  62     (:format :s3pro :make "FujiFilm" :pixels (4256 . 2848) :imager (23 . 15.5)
  63      :name "FinePix S2 Pro")
  64
  65     (:format :dcs100 :make "Kodak" :pixels (1280 . 1024) :imager (20.5 . 16.4) :name "DCS 100")
  66     (:format :dcs200 :make "Kodak" :pixels (1524 . 1008) :imager (14 . 9.3) :name "DCS 200")
  67     (:format :dcs315 :make "Kodak" :pixels (1520 . 1008) :imager nil :name "DCS 315")
  68     (:format :dcs330 :make "Kodak" :pixels (2008 . 1504) :imager nil :name "DCS 330")
  69     (:format :dcs420 :make "Kodak" :pixels (1524 . 1012) :imager (14 . 9.3) :name "DCS 420")
  70     (:format :dcs460 :make "Kodak" :pixels (3060 . 2036) :imager (27.6 . 18.4) :name "DCS 460")
  71     (:format :dcs520 :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 520")
  72     (:format :dcs560 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 560")
  73     (:format :dcs620 :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 620")
  74     (:format :dcs660 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 660")
  75     (:format :dcs720x :make "Kodak" :pixels (1728 . 1152) :imager (22.8 . 15.5) :name "DCS 720x")
  76     (:format :dcs760 :make "Kodak" :pixels (3040 . 2008) :imager (27.6 . 18.4) :name "DCS 760")
  77     (:format :dcsslr/n :make "Kodak" :pixels (4500 . 3000) :imager (36 . 24) :name "DCS SLR/n")
  78     (:format :dcsslr/c :make "Kodak" :pixels (4500 . 3000) :imager (36 . 24) :name "DCS SLR/n")
  79     (:format :dcs14n :make "Kodak" :pixels (4536 . 3024) :imager (36 . 24) :name "DCS 14n")
  80
  81     (:format :maxxum7d :make "Konica Minolta" :pixels (3008 . 2000) :imager (23.5 . 15.5)
  82      :name "Maxxum 7D")
  83
  84     (:format :d1 :make "Nikon" :pixels (2000 . 1312) :imager (23.7 . 15.6) :name "D1")
  85     (:format :d1x :make "Nikon" :pixels (4028 . 1324) :imager (23.7 . 15.6) :name "D1X")
  86     (:format :d100 :make "Nikon" :pixels (3037 . 2024) :imager (23.7 . 15.6) :name "D100")
  87     (:format :d50 :make "Nikon" :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D50")
  88     (:format :d70 :make "Nikon" :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D70")
  89     (:format :d70s :make "Nikon" :pixels (3008 . 2000) :imager (23.7 . 15.6) :name "D70s")
  90     (:format :d2h :make "Nikon" :pixels (2464 . 1632) :imager (23.3 . 15.5) :name "D2H")
  91     (:format :d2hs :make "Nikon" :pixels (2464 . 1632) :imager (23.3 . 15.5) :name "D2Hs")
  92     (:format :d2x :make "Nikon" :pixels (4288 . 2848) :imager (23.7 . 15.6) :name "D2X")
  93
  94     (:format :cp5900 :make "Nikon" :pixels (2592 . 1944) :imager (7.18 . 5.32) :name "Coolpix 5900")
  95     (:format :cp7900 :make "Nikon" :pixels (3072 . 2304) :imager (7.18 . 5.32) :name "Coolpix 7900")
  96     (:format :cp8800 :make "Nikon" :pixels (3264 . 2448) :imager (8.8 . 6.6) :name "Coolpix 8800")
  97
  98     (:format :*ist-d :make "Pentax" :pixels (3008 . 2008) :imager (36 . 24)
  99      :name "*ist D")
 100     (:format :*ist-ds :make "Pentax" :pixels (3008 . 2008) :imager (36 . 24)
 101      :name "*ist DS")
 102
 103     (:format :sd9 :make "Sigma" :pixels (2268 . 1512) :imager (20.7 . 13.8)
 104      :name "SD9")
 105     (:format :sd10 :make "Sigma" :pixels (2268 . 1512) :imager (20.7 . 13.8)
 106      :name "SD10")
 107
 108     (:format :1/1.8in :imager (7.18 . 5.32) :name "1/1.8\"")
 109     (:format :dx :imager (24 . 16) :name "DX")
 110     (:format :35mm :imager (36 . 24) :name "35mm")
 111
 112     (:format :6x4.5cm :imager (60 . 45) :name "6x4.5cm" :nicks (:\645))
 113     (:format :6x6cm :imager (60 . 60) :name "6x6cm" :nicks (:6x6))
 114     (:format :6x7cm :imager (60 . 70) :name "6x7cm" :nicks (:6x7))
 115     (:format :6x9cm :imager (60 . 90) :name "6x9cm" :nicks (:6x9))
 116     (:format :6x12cm :imager (60 . 120) :name "6x12cm" :nicks (:6x12))
 117
 118     #.(make-output-format 4 5)
 119     #.(make-output-format 5 7)
 120     #.(make-output-format 8 10)
 121     #.(make-output-format 11 13.75)
 122     #.(make-output-format 11 16.5)
 123     #.(make-output-format 13 16.25)
 124     #.(make-output-format 13 19)
 125     #.(make-output-format 16 20)
 126     #.(make-output-format 16 24)
 127     #.(make-output-format 18 22.5)
 128     #.(make-output-format 18 24)
 129     #.(make-output-format 24 30)
 130     #.(make-output-format 24 36)
 131     ))
 132
 133 (defun sort-formats (formats)
 134   (sort formats
 135         (lambda (a b)
 136           (block nil
 137             (cond
 138               ((and (null (getf a :make)) (getf b :make))
 139                (return nil))
 140               ((and (getf a :make) (null (getf b :make)))
 141                (return t))
 142               ((string-lessp (getf a :make) (getf b :make))
 143                (return t))
 144               ((string-greaterp (getf a :make) (getf b :make))
 145                (return nil)))
 146             (when (and (getf a :name) (getf b :name))
 147               (cond
 148                 ((string-lessp (getf a :name) (getf b :name))
 149                  (return t))
 150                 ((string-greaterp (getf a :name) (getf b :name))
 151                  (return nil))))))))
 152
 153 (defvar *digital-cameras*
 154   (sort-formats (loop for format in +format-db+
 155                       when (getf format :pixels)
 156                       collect format)))
 157
 158 (defvar *cameras*
 159   (sort-formats (loop for format in +format-db+
 160                       when (getf format :imager)
 161                       collect format)))
 162
 163
 164 (defun format-match-p (format-spec format)
 165   (let ((key (ensure-keyword format-spec)))
 166     (when (or (eql key (getf format :format))
 167               (member key (getf format :nicks)))
 168       t)))
 169
 170 (defun find-format (format-spec)
 171   (find format-spec +format-db+ :test 'format-match-p))
 172
 173 (defun pixel-dimensions (sensor-spec &key (format :35mm))
 174   "Returns the number of pixels for a format.
 175 CAMERA-SPEC is either a keyword designating the camera or
 176 the number of megapixels of the sensor.
 177 FORMAT should be defined if the CAMERA-SPEC is the number of megapixels
 178 so the proper aspect ratio is used."
 179   (etypecase sensor-spec
 180     ((or string keyword)
 181      (getf (find-format sensor-spec) :pixels))
 182     (number
 183      (sensor-dimensions-megapixels format sensor-spec))))
 184
 185 (defun imager-dimensions (format-spec)
 186   "Returns the imager dimensions in mm of a FORMAT."
 187   (getf (find-format format-spec) :imager))
 188
 189 (defun pixel-size (format-spec)
 190   "Return pixel size in micrometers."
 191   (let ((pixel-dim (pixel-dimensions format-spec))
 192         (imager-dim (imager-dimensions format-spec)))
 193     (when (and pixel-dim imager-dim)
 194       (values (* 1000 (/ (car imager-dim) (car pixel-dim)))
 195               (* 1000 (/ (cdr imager-dim) (cdr pixel-dim)))))))
 196
 197 (defun output-dimensions (format-spec)
 198   "Returns the output dimensions in mm of a FORMAT."
 199   (getf (find-format format-spec) :output))