;;Copyright 2011 Christian Kellermann . All ;;rights reserved. ;; ;;Redistribution and use in source and binary forms, with or without ;;modification, are permitted provided that the following conditions ;;are met: ;; 1. Redistributions of source code must retain the above ;; copyright notice, this list of conditions and the following ;; disclaimer. ;; 2. Redistributions in binary form must reproduce the above ;; copyright notice, this list of conditions and the following ;; disclaimer in the documentation and/or other materials provided ;; with the distribution. ;; THIS SOFTWARE IS PROVIDED BY CHRISTIAN KELLERMANN ``AS IS'' AND ANY ;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL CHRISTIAN KELLERMANN OR ;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF ;; USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT ;; OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ;; SUCH DAMAGE. ;; The views and conclusions contained in the software and ;; documentation are those of the authors and should not be ;; interpreted as representing official policies, either expressed or ;; implied, of Christian Kellermann. ;; This is a binding to the libexif library found at ;; http://libexif.sf.net ;; ;; Currently only reading of EXIF data is supported. For a meaning of ;; the exif tag names see http://exif.org. (module exif (tag-alist-from-file thumbnail->u8vector) (import chicken scheme) (import foreign foreigners) (use srfi-4 srfi-13 lolevel) (foreign-declare "#include ") (foreign-declare "#include ") (foreign-declare "#include ") (define-foreign-enum-type (exif-tag int) (exif-tag->int int->exif-tag) (interoperability-index EXIF_TAG_INTEROPERABILITY_INDEX) (interoperability EXIF_TAG_INTEROPERABILITY_VERSION) (new-subfile-type EXIF_TAG_NEW_SUBFILE_TYPE) (image-width EXIF_TAG_IMAGE_WIDTH) (image-length EXIF_TAG_IMAGE_LENGTH) (bits-per-sample EXIF_TAG_BITS_PER_SAMPLE) (compression EXIF_TAG_COMPRESSION) (photometric-interpretation EXIF_TAG_PHOTOMETRIC_INTERPRETATION) (fill-order EXIF_TAG_FILL_ORDER) (document-name EXIF_TAG_DOCUMENT_NAME) (image-description EXIF_TAG_IMAGE_DESCRIPTION) (make EXIF_TAG_MAKE) (model EXIF_TAG_MODEL) (strip-offsets EXIF_TAG_STRIP_OFFSETS) (orientation EXIF_TAG_ORIENTATION) (samples-per-pixel EXIF_TAG_SAMPLES_PER_PIXEL) (rows-per-strip EXIF_TAG_ROWS_PER_STRIP) (strip-byte-counts EXIF_TAG_STRIP_BYTE_COUNTS) (x-resolution EXIF_TAG_X_RESOLUTION) (y-resolution EXIF_TAG_Y_RESOLUTION) (planar-configuration EXIF_TAG_PLANAR_CONFIGURATION) (resolution-unit EXIF_TAG_RESOLUTION_UNIT) (transfer-function EXIF_TAG_TRANSFER_FUNCTION) (software EXIF_TAG_SOFTWARE) (date-time EXIF_TAG_DATE_TIME) (artist EXIF_TAG_ARTIST) (white-point EXIF_TAG_WHITE_POINT) (primary-chromaticities EXIF_TAG_PRIMARY_CHROMATICITIES) (sub-ifds EXIF_TAG_SUB_IFDS) (transfer-range EXIF_TAG_TRANSFER_RANGE) (jpeg-proc EXIF_TAG_JPEG_PROC) (jpeg-interchange_FORMAT EXIF_TAG_JPEG_INTERCHANGE_FORMAT) (jpeg-interchange_FORMAT_LENGTH EXIF_TAG_JPEG_INTERCHANGE_FORMAT_LENGTH) (ycbcr-coefficients EXIF_TAG_YCBCR_COEFFICIENTS) (ycbcr-sub-sampling EXIF_TAG_YCBCR_SUB_SAMPLING) (ycbcr-positioning EXIF_TAG_YCBCR_POSITIONING) (reference-black-white EXIF_TAG_REFERENCE_BLACK_WHITE) (xml-packet EXIF_TAG_XML_PACKET) (related-image-file-format EXIF_TAG_RELATED_IMAGE_FILE_FORMAT) (related-image-width EXIF_TAG_RELATED_IMAGE_WIDTH) (related-image-length EXIF_TAG_RELATED_IMAGE_LENGTH) (cfa-repeat-pattern_DIM EXIF_TAG_CFA_REPEAT_PATTERN_DIM) (cfa-pattern EXIF_TAG_CFA_PATTERN) (battery-level EXIF_TAG_BATTERY_LEVEL) (copyright EXIF_TAG_COPYRIGHT) (exposure-time EXIF_TAG_EXPOSURE_TIME) (fnumber EXIF_TAG_FNUMBER) (iptc-naa EXIF_TAG_IPTC_NAA) (image-resources EXIF_TAG_IMAGE_RESOURCES) (exif-ifd-pointer EXIF_TAG_EXIF_IFD_POINTER) (inter-color-profile EXIF_TAG_INTER_COLOR_PROFILE) (exposure-program EXIF_TAG_EXPOSURE_PROGRAM) (spectral-sensitivity EXIF_TAG_SPECTRAL_SENSITIVITY) (gps-info-ifd-pointer EXIF_TAG_GPS_INFO_IFD_POINTER) (iso-speed-ratings EXIF_TAG_ISO_SPEED_RATINGS) (oecf EXIF_TAG_OECF) (time-zone-offset EXIF_TAG_TIME_ZONE_OFFSET) (exif-version EXIF_TAG_EXIF_VERSION) (date-time-original EXIF_TAG_DATE_TIME_ORIGINAL) (date-time-digitized EXIF_TAG_DATE_TIME_DIGITIZED) (components-configuration EXIF_TAG_COMPONENTS_CONFIGURATION) (compressed-bits-per-pixel EXIF_TAG_COMPRESSED_BITS_PER_PIXEL) (shutter-speed-value EXIF_TAG_SHUTTER_SPEED_VALUE) (aperture-value EXIF_TAG_APERTURE_VALUE) (brightness-value EXIF_TAG_BRIGHTNESS_VALUE) (exposure-bias-value EXIF_TAG_EXPOSURE_BIAS_VALUE) (max-aperture-value EXIF_TAG_MAX_APERTURE_VALUE) (subject-distance EXIF_TAG_SUBJECT_DISTANCE) (metering-mode EXIF_TAG_METERING_MODE) (light-source EXIF_TAG_LIGHT_SOURCE) (flash EXIF_TAG_FLASH) (focal-length EXIF_TAG_FOCAL_LENGTH) (subject-area EXIF_TAG_SUBJECT_AREA) (tiff-ep-standard_ID EXIF_TAG_TIFF_EP_STANDARD_ID) (maker-note EXIF_TAG_MAKER_NOTE) (user-comment EXIF_TAG_USER_COMMENT) (sub-sec-time EXIF_TAG_SUB_SEC_TIME) (sub-sec-time_ORIGINAL EXIF_TAG_SUB_SEC_TIME_ORIGINAL) (sub-sec-time_DIGITIZED EXIF_TAG_SUB_SEC_TIME_DIGITIZED) (xp-title EXIF_TAG_XP_TITLE) (xp-comment EXIF_TAG_XP_COMMENT) (xp-author EXIF_TAG_XP_AUTHOR) (xp-keywords EXIF_TAG_XP_KEYWORDS) (xp-subject EXIF_TAG_XP_SUBJECT) (flash-pix-version EXIF_TAG_FLASH_PIX_VERSION) (color-space EXIF_TAG_COLOR_SPACE) (pixel-x-dimension EXIF_TAG_PIXEL_X_DIMENSION) (pixel-y-dimension EXIF_TAG_PIXEL_Y_DIMENSION) (related-sound-file EXIF_TAG_RELATED_SOUND_FILE) (interoperability-ifd-pointer EXIF_TAG_INTEROPERABILITY_IFD_POINTER) (flash-energy EXIF_TAG_FLASH_ENERGY) (spatial-frequency-response EXIF_TAG_SPATIAL_FREQUENCY_RESPONSE) (focal-plane-x-resolution EXIF_TAG_FOCAL_PLANE_X_RESOLUTION) (focal-plane-y-resolution EXIF_TAG_FOCAL_PLANE_Y_RESOLUTION) (focal-plane-resolution_UNIT EXIF_TAG_FOCAL_PLANE_RESOLUTION_UNIT) (subject-location EXIF_TAG_SUBJECT_LOCATION) (exposure-index EXIF_TAG_EXPOSURE_INDEX) (sensing-method EXIF_TAG_SENSING_METHOD) (file-source EXIF_TAG_FILE_SOURCE) (scene-type EXIF_TAG_SCENE_TYPE) (new-cfa-pattern EXIF_TAG_NEW_CFA_PATTERN) (custom-rendered EXIF_TAG_CUSTOM_RENDERED) (exposure-mode EXIF_TAG_EXPOSURE_MODE) (white-balance EXIF_TAG_WHITE_BALANCE) (digital-zoom_RATIO EXIF_TAG_DIGITAL_ZOOM_RATIO) (focal-length-in-35mm_FILM EXIF_TAG_FOCAL_LENGTH_IN_35MM_FILM) (scene-capture-type EXIF_TAG_SCENE_CAPTURE_TYPE) (gain-control EXIF_TAG_GAIN_CONTROL) (contrast EXIF_TAG_CONTRAST) (saturation EXIF_TAG_SATURATION) (sharpness EXIF_TAG_SHARPNESS) (device-setting-description EXIF_TAG_DEVICE_SETTING_DESCRIPTION) (subject-distance-range EXIF_TAG_SUBJECT_DISTANCE_RANGE) (image-unique-id EXIF_TAG_IMAGE_UNIQUE_ID) (gamma EXIF_TAG_GAMMA) (print-image-matching EXIF_TAG_PRINT_IMAGE_MATCHING)) (define-foreign-type exif-data (nonnull-c-pointer "ExifData")) (define exif-from-file (foreign-lambda exif-data "exif_data_new_from_file" nonnull-c-string)) (define unref-exif-data (foreign-lambda void "exif_data_unref" exif-data)) (define-foreign-type exif-entry (nonnull-c-pointer "ExifEntry")) (define unref-exif-entry (foreign-lambda void "exif_entry_unref" exif-entry)) (define get-tag (foreign-lambda* exif-entry ((exif-data d) (exif-tag t)) "C_return(exif_content_get_entry(d->ifd[EXIF_IFD_0],t) ? exif_content_get_entry(d->ifd[EXIF_IFD_0],t) : exif_content_get_entry(d->ifd[EXIF_IFD_1],t) ? exif_content_get_entry(d->ifd[EXIF_IFD_1],t) : exif_content_get_entry(d->ifd[EXIF_IFD_EXIF],t) ? exif_content_get_entry(d->ifd[EXIF_IFD_EXIF],t) : exif_content_get_entry(d->ifd[EXIF_IFD_GPS],t) ? exif_content_get_entry(d->ifd[EXIF_IFD_GPS],t) : exif_content_get_entry(d->ifd[EXIF_IFD_INTEROPERABILITY],t) ? exif_content_get_entry(d->ifd[EXIF_IFD_INTEROPERABILITY],t) : NULL);")) (define tag-value (foreign-lambda c-string "exif_entry_get_value" exif-entry c-string unsigned-integer)) (define (tag-value->string ed t #!optional (default #f)) (and-let* ((ed) (size 1024) (s (make-string size)) (t (get-tag ed t)) (r (and t (string-trim-right (tag-value t s size))))) (begin (unref-exif-entry t) r))) (define thumbnail-size (foreign-lambda* int ((c-string f)) "ExifData *ed; ExifLoader *l = exif_loader_new(); if (l) { exif_loader_write_file(l, f); ed = exif_loader_get_data(l); exif_loader_unref(l); if (ed && ed->data){ unsigned int s = ed->size; exif_data_unref(ed); C_return(s); } } C_return(0);")) (define load-thumbnail! (foreign-lambda* void ((c-string f) (u8vector v)) "ExifData *ed; ExifLoader *l = exif_loader_new(); if (l) { exif_loader_write_file(l, f); ed = exif_loader_get_data(l); exif_loader_unref(l); if (ed && ed->size && ed->data) memcpy(v, ed->data, ed->size); exif_data_unref(ed); }")) (define (thumbnail->u8vector file) (let ((size (thumbnail-size file))) (if (> size 0) (let ((vec (make-u8vector size))) (load-thumbnail! file vec) vec) #f))) (define (tag-alist-from-file f tags) (and-let* ((ed (exif-from-file f)) (_ (not (equal? (address->pointer 0) ed))) (ts (map (lambda (t) (cons t (tag-value->string ed t))) tags))) (unref-exif-data ed) ts)) )