File: cameras.lisp

package info (click to toggle)
cl-photo 0.14-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 116 kB
  • ctags: 66
  • sloc: lisp: 739; makefile: 49; sh: 28
file content (214 lines) | stat: -rw-r--r-- 10,571 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: photo -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          cameras.lisp
;;;; Purpose:       Camera-specific data for cl-photo
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  April 2005
;;;;
;;;; $Id: dof.lisp 10421 2005-04-19 21:57:00Z 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)

(defun sensor-dimensions-megapixels (format megapixels)
  (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)))))))

(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
    ((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 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))