From: tomo Date: Fri, 15 Apr 2005 14:20:12 +0000 (+0000) Subject: Rename www-image.el to album.el; rename prefix `www-image' to `album'. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0db0928b7ea52ec35771ad64da7a8545999ef67f;p=elisp%2Falbum.git Rename www-image.el to album.el; rename prefix `www-image' to `album'. --- diff --git a/album.el b/album.el new file mode 100644 index 0000000..6666e3c --- /dev/null +++ b/album.el @@ -0,0 +1,201 @@ +;;; album.el --- Photo album utility + +;; Copyright (C) 2004 MORIOKA Tomohiko + +;; Keywords: Photo, image, album, HTML, WWW + +;; This file is part of Album. + +;; Album is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; Album is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This facility is documented in the Emacs Manual. + +;;; Code: + +(defun album-make-spec-by-width (width limit spec-name) + (when (> width limit) + (let ((percent (floor (/ (* limit 100.0) width)))) + (vector percent spec-name + (/ (* width percent) 100.0) + (/ (* height percent) 100.0))))) + +(defun album-make-spec-by-height (height limit spec-name) + (when (> height limit) + (let ((percent (floor (/ (* limit 100.0) height)))) + (vector percent spec-name + (/ (* width percent) 100.0) + (/ (* height percent) 100.0))))) + +(defun album-write-html (dest-dir + prev-file file next-file + prev-grade grade next-grade) + (with-temp-buffer + (insert + "\n") + (insert "\n") + (insert (format "%s\n" file)) + (insert "\n") + (insert "\n") + (insert (format "

%s

\n" file)) + + (if prev-file + (insert (format "" prev-file))) + (insert "[Previous]") + (if prev-file + (insert "")) + (insert "\n") + + (if next-file + (insert (format "" next-file))) + (insert "[Next]") + (if next-file + (insert "")) + (insert "\n") + + (if prev-grade + (insert (format "" + prev-grade + file))) + (insert "[Smaller]") + (if prev-grade + (insert "")) + (insert "\n") + + (if next-grade + (insert (format "" + next-grade + file))) + (insert "[Larger]") + (if next-grade + (insert "")) + (insert "\n") + + (insert " +

+") + (insert "") + (insert (format " $\"%s\"$ " file file)) + (insert " + +

+ + + +") + (unless (file-exists-p + (expand-file-name (symbol-name grade) dest-dir)) + (make-directory + (expand-file-name (symbol-name grade) dest-dir))) + (write-region (point-min)(point-max) + (expand-file-name + (concat file ".html") + (expand-file-name (symbol-name grade) + dest-dir))))) + +(defun album-convert-images (dest-dir prev-file file next-file) + (let* ((ret + (with-temp-buffer + (call-process "identify" nil t t file) + (goto-char (point-min)) + (and (re-search-forward " \$[0-9]+\$x\$[0-9]+\$ " nil t) + (cons (string-to-number (match-string 1)) + (string-to-number (match-string 2)))))) + (width (car ret)) + (height (cdr ret)) + prev-grade + rest dest) + (cond ((>= width height) + (when (setq ret (album-make-spec-by-width width 2048 'QXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 1600 'UXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 1400 'SXGA+)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 1280 'SXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 1024 'XGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 800 'SVGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-width width 640 'VGA)) + (setq dest (cons ret dest))) + ) + (t + (when (setq ret (album-make-spec-by-height height 1536 'QXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 1200 'UXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 1050 'SXGA+)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 960 'SXGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 768 'XGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 600 'SVGA)) + (setq dest (cons ret dest))) + (when (setq ret (album-make-spec-by-height height 480 'VGA)) + (setq dest (cons ret dest))) + )) + (setq rest dest) + (while rest + (setq spec (car rest)) + (album-write-html dest-dir + (if prev-file + (file-name-sans-extension + (file-name-nondirectory prev-file))) + (file-name-sans-extension + (file-name-nondirectory file)) + (if next-file + (file-name-sans-extension + (file-name-nondirectory next-file))) + prev-grade + (aref spec 1) + (if (nth 1 rest) + (aref (nth 1 rest) 1))) + (call-process "convert" nil nil nil + "-resize" (format "%d%%" (aref spec 0)) + file + (expand-file-name + (concat + (file-name-sans-extension + (file-name-nondirectory file)) ".jpg") + (expand-file-name + (symbol-name (aref spec 1)) + dest-dir))) + (setq prev-grade (aref spec 1)) + (setq rest (cdr rest))) + (unless (file-exists-p + (expand-file-name "fullsize" dest-dir)) + (make-directory + (expand-file-name "fullsize" dest-dir))) + (call-process "convert" nil nil nil + file + (expand-file-name + (concat + (file-name-sans-extension + (file-name-nondirectory file)) ".jpg") + (expand-file-name "fullsize" dest-dir))) + dest)) + +;;; album.el ends here diff --git a/www-image.el b/www-image.el deleted file mode 100644 index 21b1e26..0000000 --- a/www-image.el +++ /dev/null @@ -1,189 +0,0 @@ -(defun www-image-make-spec-by-width (width limit spec-name) - (when (> width limit) - (let ((percent (floor (/ (* limit 100.0) width)))) - (vector percent spec-name - (/ (* width percent) 100.0) - (/ (* height percent) 100.0))))) - -(defun www-image-make-spec-by-height (height limit spec-name) - (when (> height limit) - (let ((percent (floor (/ (* limit 100.0) height)))) - (vector percent spec-name - (/ (* width percent) 100.0) - (/ (* height percent) 100.0))))) - -(defun www-image-write-html (dest-dir - prev-file file next-file - prev-grade grade next-grade) - (with-temp-buffer - (insert - "\n") - (insert "\n") - (insert (format "%s\n" file)) - (insert "\n") - (insert "\n") - (insert (format "

%s

\n" file)) - - (if prev-file - (insert (format "" prev-file))) - (insert "[Previous]") - (if prev-file - (insert "")) - (insert "\n") - - (if next-file - (insert (format "" next-file))) - (insert "[Next]") - (if next-file - (insert "")) - (insert "\n") - - (if prev-grade - (insert (format "" - prev-grade - file))) - (insert "[Smaller]") - (if prev-grade - (insert "")) - (insert "\n") - - (if next-grade - (insert (format "" - next-grade - file))) - (insert "[Larger]") - (if next-grade - (insert "")) - (insert "\n") - - (insert " -

-") - (insert "") - (insert (format " $\"%s\"$ " file file)) - (insert " - -

- - - -") - (unless (file-exists-p - (expand-file-name (symbol-name grade) dest-dir)) - (make-directory - (expand-file-name (symbol-name grade) dest-dir))) - (write-region (point-min)(point-max) - (expand-file-name - (concat file ".html") - (expand-file-name (symbol-name grade) - dest-dir))))) - -(defun www-image-convert-images (dest-dir - prev-file file next-file) - (let* ((ret - (with-temp-buffer - (call-process "identify" nil t t file) - (goto-char (point-min)) - (and (re-search-forward " \$[0-9]+\$x\$[0-9]+\$ " nil t) - (cons (string-to-number (match-string 1)) - (string-to-number (match-string 2)))))) - (width (car ret)) - (height (cdr ret)) - prev-grade - rest dest) - (cond ((>= width height) - (when (setq ret (www-image-make-spec-by-width width 2048 'QXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 1600 'UXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 1400 'SXGA+)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 1280 'SXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 1024 'XGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 800 'SVGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-width width 640 'VGA)) - (setq dest (cons ret dest))) - ) - (t - (when (setq ret (www-image-make-spec-by-height height 1536 'QXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 1200 'UXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 1050 'SXGA+)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 960 'SXGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 768 'XGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 600 'SVGA)) - (setq dest (cons ret dest))) - (when (setq ret (www-image-make-spec-by-height height 480 'VGA)) - (setq dest (cons ret dest))) - )) - (setq rest dest) - (while rest - (setq spec (car rest)) - (www-image-write-html dest-dir - (if prev-file - (file-name-sans-extension - (file-name-nondirectory prev-file))) - (file-name-sans-extension - (file-name-nondirectory file)) - (if next-file - (file-name-sans-extension - (file-name-nondirectory next-file))) - prev-grade - (aref spec 1) - (if (nth 1 rest) - (aref (nth 1 rest) 1))) - (call-process "convert" nil nil nil - "-resize" (format "%d%%" (aref spec 0)) - file - (expand-file-name - (concat - (file-name-sans-extension - (file-name-nondirectory file)) ".jpg") - (expand-file-name - (symbol-name (aref spec 1)) - dest-dir))) - (setq prev-grade (aref spec 1)) - (setq rest (cdr rest))) - (unless (file-exists-p - (expand-file-name "fullsize" dest-dir)) - (make-directory - (expand-file-name "fullsize" dest-dir))) - (call-process "convert" nil nil nil - file - (expand-file-name - (concat - (file-name-sans-extension - (file-name-nondirectory file)) ".jpg") - (expand-file-name "fullsize" dest-dir))) - dest)) - -(let ((rest - (append - (directory-files - "/archives/RAID2/koukotsu/TAKUHON/original/" 'full "^[^0-9].*\\.TIF$") - (directory-files - "/archives/RAID2/koukotsu/TAKUHON/original/" 'full "^[0-9].*\\.TIF$")) - ;; (directory-files - ;; "/archives/RAID2/koukotsu/TAKUHON/" t "\\.TIF$") - ) - file prev-file) - (while rest - (setq file (car rest)) - (www-image-convert-images - "/archives/RAID2/koukotsu/TAKUHON/" - prev-file file (nth 1 rest)) - (setq prev-file file - rest (cdr rest))))