source: project/release/4/exif/trunk/exif.scm @ 33716

Last change on this file since 33716 was 33716, checked in by Christian Kellermann, 4 years ago

Properly ref the exif data array, do not unref single entries, bump version

File size: 12.8 KB
Line 
1;;Copyright 2011 Christian Kellermann <ckeen@pestilenz.org>. All
2;;rights reserved.
3;;
4;;Redistribution and use in source and binary forms, with or without
5;;modification, are permitted provided that the following conditions
6;;are met:
7;;    1. Redistributions of source code must retain the above
8;;    copyright notice, this list of conditions and the following
9;;    disclaimer.
10;;    2. Redistributions in binary form must reproduce the above
11;;    copyright notice, this list of conditions and the following
12;;    disclaimer in the documentation and/or other materials provided
13;;    with the distribution.
14;; THIS SOFTWARE IS PROVIDED BY CHRISTIAN KELLERMANN ``AS IS'' AND ANY
15;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
17;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL CHRISTIAN KELLERMANN OR
18;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
19;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
20;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
21;; USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
22;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
23;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
24;; OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
25;; SUCH DAMAGE.
26;; The views and conclusions contained in the software and
27;; documentation are those of the authors and should not be
28;; interpreted as representing official policies, either expressed or
29;; implied, of Christian Kellermann.
30
31;; This is a binding to the libexif library found at
32;; http://libexif.sf.net
33;;
34;; Currently only reading of EXIF data is supported. For a meaning of
35;; the exif tag names see http://exif.org.
36
37(module
38 exif
39 (tag-alist-from-file thumbnail->u8vector)
40 (import chicken scheme)
41 (import foreign foreigners)
42
43 (use srfi-4 srfi-13 lolevel)
44
45 (foreign-declare "#include <libexif/exif-data.h>")
46 (foreign-declare "#include <libexif/exif-tag.h>")
47 (foreign-declare "#include <libexif/exif-loader.h>")
48
49 (define-foreign-enum-type
50   (exif-tag int)
51   (exif-tag->int int->exif-tag)
52   (interoperability-index EXIF_TAG_INTEROPERABILITY_INDEX)
53   (interoperability EXIF_TAG_INTEROPERABILITY_VERSION)
54   (new-subfile-type EXIF_TAG_NEW_SUBFILE_TYPE)
55   (image-width EXIF_TAG_IMAGE_WIDTH)
56   (image-length EXIF_TAG_IMAGE_LENGTH)
57   (bits-per-sample EXIF_TAG_BITS_PER_SAMPLE)
58   (compression EXIF_TAG_COMPRESSION)
59   (photometric-interpretation EXIF_TAG_PHOTOMETRIC_INTERPRETATION)
60   (fill-order EXIF_TAG_FILL_ORDER)
61   (document-name EXIF_TAG_DOCUMENT_NAME)
62   (image-description EXIF_TAG_IMAGE_DESCRIPTION)
63   (make EXIF_TAG_MAKE)
64   (model EXIF_TAG_MODEL)
65   (strip-offsets EXIF_TAG_STRIP_OFFSETS)
66   (orientation EXIF_TAG_ORIENTATION)
67   (samples-per-pixel EXIF_TAG_SAMPLES_PER_PIXEL)
68   (rows-per-strip EXIF_TAG_ROWS_PER_STRIP)
69   (strip-byte-counts EXIF_TAG_STRIP_BYTE_COUNTS)
70   (x-resolution EXIF_TAG_X_RESOLUTION)
71   (y-resolution EXIF_TAG_Y_RESOLUTION)
72   (planar-configuration EXIF_TAG_PLANAR_CONFIGURATION)
73   (resolution-unit EXIF_TAG_RESOLUTION_UNIT)
74   (transfer-function EXIF_TAG_TRANSFER_FUNCTION)
75   (software EXIF_TAG_SOFTWARE)
76   (date-time EXIF_TAG_DATE_TIME)
77   (artist EXIF_TAG_ARTIST)
78   (white-point EXIF_TAG_WHITE_POINT)
79   (primary-chromaticities EXIF_TAG_PRIMARY_CHROMATICITIES)
80   (sub-ifds EXIF_TAG_SUB_IFDS)
81   (transfer-range EXIF_TAG_TRANSFER_RANGE)
82   (jpeg-proc EXIF_TAG_JPEG_PROC)
83   (jpeg-interchange_FORMAT EXIF_TAG_JPEG_INTERCHANGE_FORMAT)
84   (jpeg-interchange_FORMAT_LENGTH EXIF_TAG_JPEG_INTERCHANGE_FORMAT_LENGTH)
85   (ycbcr-coefficients EXIF_TAG_YCBCR_COEFFICIENTS)
86   (ycbcr-sub-sampling EXIF_TAG_YCBCR_SUB_SAMPLING)
87   (ycbcr-positioning EXIF_TAG_YCBCR_POSITIONING)
88   (reference-black-white EXIF_TAG_REFERENCE_BLACK_WHITE)
89   (xml-packet EXIF_TAG_XML_PACKET)
90   (related-image-file-format EXIF_TAG_RELATED_IMAGE_FILE_FORMAT)
91   (related-image-width EXIF_TAG_RELATED_IMAGE_WIDTH)
92   (related-image-length EXIF_TAG_RELATED_IMAGE_LENGTH)
93   (cfa-repeat-pattern_DIM EXIF_TAG_CFA_REPEAT_PATTERN_DIM)
94   (cfa-pattern EXIF_TAG_CFA_PATTERN)
95   (battery-level EXIF_TAG_BATTERY_LEVEL)
96   (copyright EXIF_TAG_COPYRIGHT)
97   (exposure-time EXIF_TAG_EXPOSURE_TIME)
98   (fnumber EXIF_TAG_FNUMBER)
99   (iptc-naa EXIF_TAG_IPTC_NAA)
100   (image-resources EXIF_TAG_IMAGE_RESOURCES)
101   (exif-ifd-pointer EXIF_TAG_EXIF_IFD_POINTER)
102   (inter-color-profile EXIF_TAG_INTER_COLOR_PROFILE)
103   (exposure-program EXIF_TAG_EXPOSURE_PROGRAM)
104   (spectral-sensitivity EXIF_TAG_SPECTRAL_SENSITIVITY)
105   (gps-info-ifd-pointer EXIF_TAG_GPS_INFO_IFD_POINTER)
106   (iso-speed-ratings EXIF_TAG_ISO_SPEED_RATINGS)
107   (oecf EXIF_TAG_OECF)
108   (time-zone-offset EXIF_TAG_TIME_ZONE_OFFSET)
109   (exif-version EXIF_TAG_EXIF_VERSION)
110   (date-time-original EXIF_TAG_DATE_TIME_ORIGINAL)
111   (date-time-digitized EXIF_TAG_DATE_TIME_DIGITIZED)
112   (components-configuration EXIF_TAG_COMPONENTS_CONFIGURATION)
113   (compressed-bits-per-pixel EXIF_TAG_COMPRESSED_BITS_PER_PIXEL)
114   (shutter-speed-value EXIF_TAG_SHUTTER_SPEED_VALUE)
115   (aperture-value EXIF_TAG_APERTURE_VALUE)
116   (brightness-value EXIF_TAG_BRIGHTNESS_VALUE)
117   (exposure-bias-value EXIF_TAG_EXPOSURE_BIAS_VALUE)
118   (max-aperture-value EXIF_TAG_MAX_APERTURE_VALUE)
119   (subject-distance EXIF_TAG_SUBJECT_DISTANCE)
120   (metering-mode EXIF_TAG_METERING_MODE)
121   (light-source EXIF_TAG_LIGHT_SOURCE)
122   (flash EXIF_TAG_FLASH)
123   (focal-length EXIF_TAG_FOCAL_LENGTH)
124   (subject-area EXIF_TAG_SUBJECT_AREA)
125   (tiff-ep-standard_ID EXIF_TAG_TIFF_EP_STANDARD_ID)
126   (maker-note EXIF_TAG_MAKER_NOTE)
127   (user-comment EXIF_TAG_USER_COMMENT)
128   (sub-sec-time EXIF_TAG_SUB_SEC_TIME)
129   (sub-sec-time_ORIGINAL EXIF_TAG_SUB_SEC_TIME_ORIGINAL)
130   (sub-sec-time_DIGITIZED EXIF_TAG_SUB_SEC_TIME_DIGITIZED)
131   (xp-title EXIF_TAG_XP_TITLE)
132   (xp-comment EXIF_TAG_XP_COMMENT)
133   (xp-author EXIF_TAG_XP_AUTHOR)
134   (xp-keywords EXIF_TAG_XP_KEYWORDS)
135   (xp-subject EXIF_TAG_XP_SUBJECT)
136   (flash-pix-version EXIF_TAG_FLASH_PIX_VERSION)
137   (color-space EXIF_TAG_COLOR_SPACE)
138   (pixel-x-dimension EXIF_TAG_PIXEL_X_DIMENSION)
139   (pixel-y-dimension EXIF_TAG_PIXEL_Y_DIMENSION)
140   (related-sound-file EXIF_TAG_RELATED_SOUND_FILE)
141   (interoperability-ifd-pointer EXIF_TAG_INTEROPERABILITY_IFD_POINTER)
142   (flash-energy EXIF_TAG_FLASH_ENERGY)
143   (spatial-frequency-response EXIF_TAG_SPATIAL_FREQUENCY_RESPONSE)
144   (focal-plane-x-resolution EXIF_TAG_FOCAL_PLANE_X_RESOLUTION)
145   (focal-plane-y-resolution EXIF_TAG_FOCAL_PLANE_Y_RESOLUTION)
146   (focal-plane-resolution_UNIT EXIF_TAG_FOCAL_PLANE_RESOLUTION_UNIT)
147   (subject-location EXIF_TAG_SUBJECT_LOCATION)
148   (exposure-index EXIF_TAG_EXPOSURE_INDEX)
149   (sensing-method EXIF_TAG_SENSING_METHOD)
150   (file-source EXIF_TAG_FILE_SOURCE)
151   (scene-type EXIF_TAG_SCENE_TYPE)
152   (new-cfa-pattern EXIF_TAG_NEW_CFA_PATTERN)
153   (custom-rendered EXIF_TAG_CUSTOM_RENDERED)
154   (exposure-mode EXIF_TAG_EXPOSURE_MODE)
155   (white-balance EXIF_TAG_WHITE_BALANCE)
156   (digital-zoom_RATIO EXIF_TAG_DIGITAL_ZOOM_RATIO)
157   (focal-length-in-35mm_FILM EXIF_TAG_FOCAL_LENGTH_IN_35MM_FILM)
158   (scene-capture-type EXIF_TAG_SCENE_CAPTURE_TYPE)
159   (gain-control EXIF_TAG_GAIN_CONTROL)
160   (contrast EXIF_TAG_CONTRAST)
161   (saturation EXIF_TAG_SATURATION)
162   (sharpness EXIF_TAG_SHARPNESS)
163   (device-setting-description EXIF_TAG_DEVICE_SETTING_DESCRIPTION)
164   (subject-distance-range EXIF_TAG_SUBJECT_DISTANCE_RANGE)
165   (image-unique-id EXIF_TAG_IMAGE_UNIQUE_ID)
166   (gamma EXIF_TAG_GAMMA)
167   (print-image-matching EXIF_TAG_PRINT_IMAGE_MATCHING))
168
169(define tags
170  '(interoperability-index
171    interoperability
172    new-subfile-type
173    image-width
174    image-length
175    bits-per-sample
176    compression
177    photometric-interpretation
178    fill-order
179    document-name
180    image-description
181    make
182    model
183    strip-offsets
184    orientation
185    samples-per-pixel
186    rows-per-strip
187    strip-byte-counts
188    x-resolution
189    y-resolution
190    planar-configuration
191    resolution-unit
192    transfer-function
193    software
194    date-time
195    artist
196    white-point
197    primary-chromaticities
198    sub-ifds
199    transfer-range
200    jpeg-proc
201    jpeg-interchange_FORMAT
202    jpeg-interchange_FORMAT_LENGTH
203    ycbcr-coefficients
204    ycbcr-sub-sampling
205    ycbcr-positioning
206    reference-black-white
207    xml-packet
208    related-image-file-format
209    related-image-width
210    related-image-length
211    cfa-repeat-pattern_DIM
212    cfa-pattern
213    battery-level
214    copyright
215    exposure-time
216    fnumber
217    iptc-naa
218    image-resources
219    exif-ifd-pointer
220    inter-color-profile
221    exposure-program
222    spectral-sensitivity
223    gps-info-ifd-pointer
224    iso-speed-ratings
225    oecf
226    time-zone-offset
227    exif-version
228    date-time-original
229    date-time-digitized
230    components-configuration
231    compressed-bits-per-pixel
232    shutter-speed-value
233    aperture-value
234    brightness-value
235    exposure-bias-value
236    max-aperture-value
237    subject-distance
238    metering-mode
239    light-source
240    flash
241    focal-length
242    subject-area
243    tiff-ep-standard_ID
244    maker-note
245    user-comment
246    sub-sec-time
247    sub-sec-time_ORIGINAL
248    sub-sec-time_DIGITIZED
249    xp-title
250    xp-comment
251    xp-author
252    xp-keywords
253    xp-subject
254    flash-pix-version
255    color-space
256    pixel-x-dimension
257    pixel-y-dimension
258    related-sound-file
259    interoperability-ifd-pointer
260    flash-energy
261    spatial-frequency-response
262    focal-plane-x-resolution
263    focal-plane-y-resolution
264    focal-plane-resolution_UNIT
265    subject-location
266    exposure-index
267    sensing-method
268    file-source
269    scene-type
270    new-cfa-pattern
271    custom-rendered
272    exposure-mode
273    white-balance
274    digital-zoom_RATIO
275    focal-length-in-35mm_FILM
276    scene-capture-type
277    gain-control
278    contrast
279    saturation
280    sharpness
281    device-setting-description
282    subject-distance-range
283    image-unique-id
284    gamma
285    print-image-matching))
286
287 (define-foreign-type exif-data (c-pointer "ExifData"))
288 (define exif-from-file
289   (foreign-lambda exif-data "exif_data_new_from_file" nonnull-c-string))
290 (define unref-exif-data
291   (foreign-lambda void "exif_data_unref" exif-data))
292 (define ref-exif-data
293   (foreign-lambda void "exif_data_ref" exif-data))
294
295 (define-foreign-type exif-entry (c-pointer "ExifEntry"))
296 (define unref-exif-entry
297   (foreign-lambda void "exif_entry_unref" exif-entry))
298
299 (define get-tag
300   (foreign-lambda* exif-entry ((exif-data d)
301                                (exif-tag t))
302        "C_return(exif_content_get_entry(d->ifd[EXIF_IFD_0],t) ?
303         exif_content_get_entry(d->ifd[EXIF_IFD_0],t) :
304         exif_content_get_entry(d->ifd[EXIF_IFD_1],t) ?
305         exif_content_get_entry(d->ifd[EXIF_IFD_1],t) :
306         exif_content_get_entry(d->ifd[EXIF_IFD_EXIF],t) ?
307         exif_content_get_entry(d->ifd[EXIF_IFD_EXIF],t) :
308         exif_content_get_entry(d->ifd[EXIF_IFD_GPS],t) ?
309         exif_content_get_entry(d->ifd[EXIF_IFD_GPS],t) :
310         exif_content_get_entry(d->ifd[EXIF_IFD_INTEROPERABILITY],t) ?
311         exif_content_get_entry(d->ifd[EXIF_IFD_INTEROPERABILITY],t) : NULL);"))
312
313 (define tag-value
314   (foreign-lambda c-string "exif_entry_get_value" exif-entry c-string unsigned-integer))
315
316(define (tag-value->string ed t)
317   (and-let* ((ed)
318              (size 1024)
319              (s (make-string size))
320              (t (get-tag ed t))
321              (r (and t (string-trim-right (tag-value t s size)))))
322             r))
323
324(define thumbnail-size
325   (foreign-lambda* int ((c-string f))
326                    "ExifData *ed;
327                     ExifLoader *l = exif_loader_new();
328                     if (l) {
329                        exif_loader_write_file(l, f);
330                        ed = exif_loader_get_data(l);
331                        exif_loader_unref(l);
332                        if (ed && ed->data){
333                                unsigned int s = ed->size;
334                                exif_data_unref(ed);
335                                C_return(s);
336                        }
337                     }
338                     C_return(0);"))
339
340 (define load-thumbnail!
341   (foreign-lambda* void ((c-string f)
342                          (u8vector v))
343                    "ExifData *ed;
344                     ExifLoader *l = exif_loader_new();
345                     if (l) {
346                        exif_loader_write_file(l, f);
347                        ed = exif_loader_get_data(l);
348                        exif_loader_unref(l);
349                        if (ed && ed->size && ed->data)
350                                memcpy(v, ed->data, ed->size);
351                        exif_data_unref(ed);
352                     }"))
353
354 (define (thumbnail->u8vector file)
355   (let ((size (thumbnail-size file)))
356     (if (> size 0)
357         (let ((vec (make-u8vector size)))
358           (load-thumbnail! file vec)
359           vec)
360         #f)))
361
362(define (tag-alist-from-file f #!optional (tags tags))
363  (and-let* ((ed (exif-from-file f))
364             (_ (not (equal? (address->pointer 0) ed)))
365             (_ (ref-exif-data ed))
366             (ts (map (lambda (t)
367                        (cons t (tag-value->string ed t)))
368                      tags)))
369            (unref-exif-data ed)
370            ts))
371)
Note: See TracBrowser for help on using the repository browser.