album.el

   1 ;;; album.el --- Photo album utility
   2
   3 ;; Copyright (C) 2005 MORIOKA Tomohiko
   4
   5 ;; Keywords: Photo, image, album, HTML, WWW
   6
   7 ;; This file is part of Album.
   8
   9 ;; Album is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; Album is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; It requires `convert' and `identify' of ImageMagick.
  27
  28 ;;; Code:
  29
  30 (defun album-make-spec-by-width (width limit spec-name)
  31   (when (> width limit)
  32     (let ((percent (floor (/ (* limit 100.0) width))))
  33       (vector percent spec-name
  34               (/ (* width percent) 100.0)
  35               (/ (* height percent) 100.0)))))
  36
  37 (defun album-make-spec-by-height (height limit spec-name)
  38   (when (> height limit)
  39     (let ((percent (floor (/ (* limit 100.0) height))))
  40       (vector percent spec-name
  41               (/ (* width percent) 100.0)
  42               (/ (* height percent) 100.0)))))
  43
  44 (defun album-write-html (dest-dir image-url-prefix
  45                          prev-file file next-file
  46                          prev-grade grade next-grade)
  47   (with-temp-buffer
  48     (insert
  49      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
  50             \"http://www.w3.org/TR/html4/loose.dtd\">\n")
  51     (insert "<head>\n")
  52     (insert (format "<title>%s</title>\n" file))
  53     (insert "</head>\n")
  54     (insert "<body>\n")
  55     (insert (format "<h1>%s</h1>\n" file))
  56
  57     (if prev-file
  58         (insert (format "<a href=\"%s.html\">" prev-file)))
  59     (insert "[Previous]")
  60     (if prev-file
  61         (insert "</a>"))
  62     (insert "\n")
  63
  64     (if next-file
  65         (insert (format "<a href=\"%s.html\">" next-file)))
  66     (insert "[Next]")
  67     (if next-file
  68         (insert "</a>"))
  69     (insert "\n")
  70
  71     (if prev-grade
  72         (insert (format "<a href=\"../%s/%s.html\">"
  73                         prev-grade
  74                         file)))
  75     (insert "[Smaller]")
  76     (if prev-grade
  77         (insert "</a>"))
  78     (insert "\n")
  79
  80     (if next-grade
  81         (insert (format "<a href=\"../%s/%s.html\">"
  82                         next-grade
  83                         file)))
  84     (insert "[Larger]")
  85     (if next-grade
  86         (insert "</a>"))
  87     (insert "\n")
  88
  89     (insert "
  90 <hr>
  91 ")
  92     (insert "<a href=\"")
  93     (insert
  94      (if next-grade
  95           (format "../%s/%s.html" next-grade file)
  96        (concat "../fullsize/" file ".jpg")))
  97     (insert "\">")
  98     (insert (format "<img alt=\"%s\" src=\"%s.jpg\">"
  99                     file
 100                     (if image-url-prefix
 101                         (format "%s/%s/%s"
 102                                 image-url-prefix grade file)
 103                       file)))
 104     (insert "</a>
 105
 106 <hr>
 107
 108 </body>
 109 </html>
 110 ")
 111     (unless (file-exists-p
 112              (expand-file-name (symbol-name grade) dest-dir))
 113       (make-directory
 114        (expand-file-name (symbol-name grade) dest-dir)))
 115     (write-region (point-min)(point-max)
 116                   (expand-file-name
 117                    (concat file ".html")
 118                    (expand-file-name (symbol-name grade)
 119                                      dest-dir)))))
 120
 121 (defun album-convert-image (image-dest-dir html-dest-dir image-url-prefix
 122                                            prev-file file next-file)
 123   (setq file (expand-file-name file))
 124   (unless html-dest-dir
 125     (setq html-dest-dir image-dest-dir))
 126   (let* ((ret
 127           (with-temp-buffer
 128             (call-process "identify" nil t t file)
 129             (goto-char (point-min))
 130             (and (re-search-forward " \\([0-9]+\\)x\\([0-9]+\\) " nil t)
 131                  (cons (string-to-number (match-string 1))
 132                        (string-to-number (match-string 2))))))
 133          (width (car ret))
 134          (height (cdr ret))
 135          prev-grade
 136          rest dest)
 137     (cond ((>= width height)
 138            (when (setq ret (album-make-spec-by-width width 2048 'QXGA))
 139              (setq dest (cons ret dest)))
 140            (when (setq ret (album-make-spec-by-width width 1600 'UXGA))
 141              (setq dest (cons ret dest)))
 142            (when (setq ret (album-make-spec-by-width width 1400 'SXGA+))
 143              (setq dest (cons ret dest)))
 144            (when (setq ret (album-make-spec-by-width width 1280 'SXGA))
 145              (setq dest (cons ret dest)))
 146            (when (setq ret (album-make-spec-by-width width 1024 'XGA))
 147              (setq dest (cons ret dest)))
 148            (when (setq ret (album-make-spec-by-width width 800 'SVGA))
 149              (setq dest (cons ret dest)))
 150            (when (setq ret (album-make-spec-by-width width 640 'VGA))
 151              (setq dest (cons ret dest)))
 152            )
 153           (t
 154            (when (setq ret (album-make-spec-by-height height 1536 'QXGA))
 155              (setq dest (cons ret dest)))
 156            (when (setq ret (album-make-spec-by-height height 1200 'UXGA))
 157              (setq dest (cons ret dest)))
 158            (when (setq ret (album-make-spec-by-height height 1050 'SXGA+))
 159              (setq dest (cons ret dest)))
 160            (when (setq ret (album-make-spec-by-height height 960 'SXGA))
 161              (setq dest (cons ret dest)))
 162            (when (setq ret (album-make-spec-by-height height 768 'XGA))
 163              (setq dest (cons ret dest)))
 164            (when (setq ret (album-make-spec-by-height height 600 'SVGA))
 165              (setq dest (cons ret dest)))
 166            (when (setq ret (album-make-spec-by-height height 480 'VGA))
 167              (setq dest (cons ret dest)))
 168            ))
 169     (setq rest dest)
 170     (while rest
 171       (setq spec (car rest))
 172       (album-write-html html-dest-dir image-url-prefix
 173                         (if prev-file
 174                             (file-name-sans-extension
 175                              (file-name-nondirectory prev-file)))
 176                         (file-name-sans-extension
 177                          (file-name-nondirectory file))
 178                         (if next-file
 179                             (file-name-sans-extension
 180                              (file-name-nondirectory next-file)))
 181                         prev-grade
 182                         (aref spec 1)
 183                         (if (nth 1 rest)
 184                             (aref (nth 1 rest) 1)))
 185       (call-process "convert" nil nil nil
 186                     "-resize" (format "%d%%" (aref spec 0))
 187                     file
 188                     (expand-file-name
 189                      (concat
 190                       (file-name-sans-extension
 191                        (file-name-nondirectory file)) ".jpg")
 192                      (expand-file-name
 193                       (symbol-name (aref spec 1))
 194                       image-dest-dir)))
 195       (setq prev-grade (aref spec 1))
 196       (setq rest (cdr rest)))
 197     (unless (file-exists-p
 198              (expand-file-name "fullsize" image-dest-dir))
 199       (make-directory
 200        (expand-file-name "fullsize" image-dest-dir)))
 201     (if (string= (downcase (file-name-extension file))
 202                  "jpg")
 203         (call-process "ln" nil nil nil
 204                       "-f"
 205                       file
 206                       (expand-file-name "fullsize" image-dest-dir))
 207       (call-process "convert" nil nil nil
 208                     file
 209                     (expand-file-name
 210                      (concat
 211                       (file-name-sans-extension
 212                        (file-name-nondirectory file)) ".jpg")
 213                      (expand-file-name "fullsize" image-dest-dir))))
 214     dest))
 215
 216 (defun album-convert-images (image-dest-dir html-dest-dir
 217                                             image-url-prefix
 218                                             &rest source-images)
 219   (if (and (consp (car source-images))
 220            (null (cdr source-images)))
 221       (setq source-images (car source-images)))
 222   (let (file prev-file)
 223     (while source-images
 224       (setq file (car source-images))
 225       (album-convert-image image-dest-dir html-dest-dir
 226                            image-url-prefix
 227                            prev-file file (nth 1 source-images))
 228       (setq prev-file file
 229             source-images (cdr source-images)))))
 230
 231 (defun album-convert-directory (image-dest-dir html-dest-dir
 232                                                image-url-prefix
 233                                                source-dir &rest patterns)
 234   (let (files)
 235     (if patterns
 236         (dolist (pat patterns)
 237           (setq files
 238                 (append files
 239                         (directory-files source-dir 'full pat))))
 240       (setq files
 241             (let (case-fold-search)
 242               (directory-files
 243                source-dir 'full
 244                ".+\\.\\(tiff\\|jpg\\|JPG\\|jpeg\\|gif\\|png\\)$"))))
 245     (album-convert-images image-dest-dir html-dest-dir
 246                           image-url-prefix files)))
 247
 248
 249 (provide 'album)
 250
 251 ;;; album.el ends here