(in-package #:photo-store) (defun degrees-to-rational (deg ref) (when deg (let ((rational (+ (elt deg 0) (/ (elt deg 1) 60) (/ (elt deg 2) 3600)))) (if (member ref '("N" "E") :test #'equal) rational (- rational))))) (defun exif-to-point (exif) (when exif (let ((lat (degrees-to-rational (zpb-exif:exif-value :GPSLatitude exif) (zpb-exif:exif-value :GPSLatitudeRef exif))) (lon (degrees-to-rational (zpb-exif:exif-value :GPSLongitude exif) (zpb-exif:exif-value :GPSLongitudeRef exif)))) (and lat lon (geo:point-deg lat lon))))) (defun exif-to-taken (exif) (when exif (or (zpb-exif:parsed-exif-value :DateTimeOriginal exif) (zpb-exif:parsed-exif-value :DateTime exif)))) (defun exif-to-dim (exif) (when exif (let ((width (and exif (or (zpb-exif:exif-value :PixelXDimension exif) (zpb-exif:exif-value :ImageWidth exif)))) (height (and exif (or (zpb-exif:exif-value :PixelYDimension exif) (zpb-exif:exif-value :ImageHeight exif))))) (and width height (list width height))))) (defun get-dims (path) (with-open-file (in path :element-type '(unsigned-byte 8)) (case (intern (string-upcase (pathname-type path)) "KEYWORD") (:jpg (multiple-value-bind (h w) (jpeg:decode-stream-height-width in) (list w h))) (:png (let ((png (png-read:read-png-datastream in))) (list (png-read:width png) (png-read:height png))))))) (defun load-photo-info (path) (with-open-file (in path :element-type '(unsigned-byte 8)) (let ((length (file-length in)) (modified (file-write-date path)) (exif (ignore-errors (zpb-exif:make-exif in)))) (list (cons :path path) (cons :name (pathname-name path)) (cons :modified modified) (cons :length length) (cons :created-at (local-time:universal-to-timestamp (or (exif-to-taken exif) modified))) (cons :dim (or (exif-to-dim exif) (get-dims path))) (cons :location (exif-to-point exif))))))