1 ;;; album.el --- Photo album utility
3 ;; Copyright (C) 2005,2006 MORIOKA Tomohiko
5 ;; Keywords: Photo, image, album, HTML, WWW
7 ;; This file is part of Album.
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)
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.
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.
26 ;; It requires `convert' and `identify' of ImageMagick.
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)))))
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)))))
44 (defun album-write-html (dest-dir
45 prev-file file next-file
46 prev-grade grade next-grade
47 lang image-url-prefix)
50 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
51 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
54 (insert (format " lang=\"%s\"" lang)))
57 (insert (format "<title>%s</title>\n" file))
60 ;; (insert (format "<h1>%s</h1>\n" file))
63 (insert (format "<a href=\"%s.html\">" prev-file)))
70 (insert (format "<a href=\"%s.html\">" next-file)))
77 (insert (format "<a href=\"../%s/%s.html\">"
86 (insert (format "<a href=\"../%s/%s.html\">"
100 (format "../%s/%s.html" next-grade file)
101 (concat "../fullsize/" file ".jpg")))
103 (insert (format "<img alt=\"%s\" src=\"%s.jpg\">"
107 image-url-prefix grade file)
113 <a href=\"../index.html\">[index]</a>
118 (unless (file-exists-p
119 (expand-file-name (symbol-name grade) dest-dir))
121 (expand-file-name (symbol-name grade) dest-dir)))
122 (write-region (point-min)(point-max)
124 (concat file ".html")
125 (expand-file-name (symbol-name grade)
128 (defun album-convert-image (image-dest-dir
129 prev-file file next-file
130 lang image-url-prefix
132 (setq file (expand-file-name file))
133 (unless html-dest-dir
134 (setq html-dest-dir image-dest-dir))
137 (call-process "identify" nil t t file)
138 (goto-char (point-min))
139 (and (re-search-forward " \\([0-9]+\\)x\\([0-9]+\\) " nil t)
140 (cons (string-to-number (match-string 1))
141 (string-to-number (match-string 2))))))
144 (specs '((QVGA 320 240)
159 ;; (cond ((>= width height)
160 ;; (when (setq ret (album-make-spec-by-width width 2048 'QXGA))
161 ;; (setq dest (cons ret dest)))
162 ;; (when (setq ret (album-make-spec-by-width width 1600 'UXGA))
163 ;; (setq dest (cons ret dest)))
164 ;; (when (setq ret (album-make-spec-by-width width 1400 'SXGA+))
165 ;; (setq dest (cons ret dest)))
166 ;; (when (setq ret (album-make-spec-by-width width 1280 'SXGA))
167 ;; (setq dest (cons ret dest)))
168 ;; (when (setq ret (album-make-spec-by-width width 1024 'XGA))
169 ;; (setq dest (cons ret dest)))
170 ;; (when (setq ret (album-make-spec-by-width width 800 'SVGA))
171 ;; (setq dest (cons ret dest)))
172 ;; (when (setq ret (album-make-spec-by-width width 640 'VGA))
173 ;; (setq dest (cons ret dest)))
174 ;; (when (setq ret (album-make-spec-by-width width 320 'QVGA))
175 ;; (setq dest (cons ret dest)))
176 ;; (when (setq ret (album-make-spec-by-width width 160 'thumbnail))
177 ;; (setq dest (cons ret dest)))
180 ;; (when (setq ret (album-make-spec-by-height height 1536 'QXGA))
181 ;; (setq dest (cons ret dest)))
182 ;; (when (setq ret (album-make-spec-by-height height 1200 'UXGA))
183 ;; (setq dest (cons ret dest)))
184 ;; (when (setq ret (album-make-spec-by-height height 1050 'SXGA+))
185 ;; (setq dest (cons ret dest)))
186 ;; (when (setq ret (album-make-spec-by-height height 960 'SXGA))
187 ;; (setq dest (cons ret dest)))
188 ;; (when (setq ret (album-make-spec-by-height height 768 'XGA))
189 ;; (setq dest (cons ret dest)))
190 ;; (when (setq ret (album-make-spec-by-height height 600 'SVGA))
191 ;; (setq dest (cons ret dest)))
192 ;; (when (setq ret (album-make-spec-by-height height 480 'VGA))
193 ;; (setq dest (cons ret dest)))
194 ;; (when (setq ret (album-make-spec-by-height height 240 'QVGA))
195 ;; (setq dest (cons ret dest)))
196 ;; (when (setq ret (album-make-spec-by-height height 160 'thumbnail))
197 ;; (setq dest (cons ret dest)))
199 (unless (file-exists-p
200 (expand-file-name "thumbnail" image-dest-dir))
202 (expand-file-name "thumbnail" image-dest-dir)))
203 (call-process "convert" nil nil nil
204 "-resize" "160x160>" ; (format "%d%%" (aref (car dest) 0))
208 (file-name-sans-extension
209 (file-name-nondirectory file)) ".jpg")
214 ;; (setq rest (cdr dest))
216 (setq spec (car rest))
217 (when (or (> width (nth 1 spec))
218 (> height (nth 2 spec)))
219 (album-write-html html-dest-dir
221 (file-name-sans-extension
222 (file-name-nondirectory prev-file)))
223 (file-name-sans-extension
224 (file-name-nondirectory file))
226 (file-name-sans-extension
227 (file-name-nondirectory next-file)))
229 (car spec) ; (aref spec 1)
231 ;; (aref (nth 1 rest) 1)
234 lang image-url-prefix)
235 (call-process "convert" nil nil nil
236 "-resize" ; (format "%d%%" (aref spec 0))
237 (format "%dx%d>" (nth 1 spec)(nth 2 spec))
241 (file-name-sans-extension
242 (file-name-nondirectory file)) ".jpg")
244 (symbol-name (car spec) ; (aref spec 1)
247 ;; (setq prev-grade (aref spec 1))
248 (setq prev-grade (car spec))
250 (setq rest (cdr rest)))
251 (unless (file-exists-p
252 (expand-file-name "fullsize" image-dest-dir))
254 (expand-file-name "fullsize" image-dest-dir)))
255 (if (string= (downcase (file-name-extension file))
257 (call-process "ln" nil nil nil
260 (expand-file-name "fullsize" image-dest-dir))
261 (call-process "convert" nil nil nil
265 (file-name-sans-extension
266 (file-name-nondirectory file)) ".jpg")
267 (expand-file-name "fullsize" image-dest-dir))))
270 (defun album-convert-images (image-dest-dir source-images
271 &optional lang title parent-url
272 image-url-prefix html-dest-dir)
273 (unless html-dest-dir
274 (setq html-dest-dir image-dest-dir))
275 ;; (if (and (consp (car source-images))
276 ;; (null (cdr source-images)))
277 ;; (setq source-images (car source-images)))
278 (album-make-thumbnails html-dest-dir source-images
279 lang title image-url-prefix parent-url)
280 (let (file prev-file)
282 (setq file (car source-images))
283 (album-convert-image image-dest-dir
284 prev-file file (nth 1 source-images)
285 lang image-url-prefix html-dest-dir)
287 source-images (cdr source-images)))))
289 (defun album-make-thumbnails (html-dest-dir
291 lang title image-url-prefix parent-url)
294 (file-name-nondirectory
295 (if (eq (aref html-dest-dir (1- (length html-dest-dir))) ?/)
296 (substring html-dest-dir 0 (1- (length html-dest-dir)))
301 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
302 \"http://www.w3.org/TR/html4/loose.dtd\">\n")
305 (insert (format " lang=\"%s\"" lang)))
308 (insert (format "<title>%s</title>\n" title))
311 (insert (format "<h1>%s</h1>\n" title))
316 (dolist (image-file source-images)
317 (setq file (file-name-sans-extension
318 (file-name-nondirectory image-file)))
319 (insert "<a href=\"VGA/")
322 (insert (format "<img alt=\"%s\" src=\"thumbnail/%s.jpg\">"
326 image-url-prefix grade file)
334 (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
340 (write-region (point-min)(point-max)
341 (expand-file-name "index.html" html-dest-dir)))))
343 (defun album-convert-directory (image-dest-dir source-dir
346 lang title parent-url
347 image-url-prefix html-dest-dir)
350 (dolist (pat patterns)
353 (directory-files source-dir 'full pat))))
355 (let (case-fold-search)
358 ".+\\.\\(tiff\\|TIFF\\|jpg\\|JPG\\|jpeg\\|JPEG\\|gif\\|GIF\\|png\\|PNG\\)$"))))
359 (album-convert-images image-dest-dir files
360 lang title parent-url
361 image-url-prefix html-dest-dir)))
366 ;;; album.el ends here