X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=album.el;h=b3323078b24b5a9cfbb3745409e57eeec6f642e3;hb=784f92d8626114de34439f035ea40c0998c42058;hp=caa22017c60265b9443c60618113077d8f2bc247;hpb=2c4a71d937d0d937d921b1b5a77b067b241cd94b;p=elisp%2Falbum.git
diff --git a/album.el b/album.el
index caa2201..b332307 100644
--- a/album.el
+++ b/album.el
@@ -1,6 +1,6 @@
;;; album.el --- Photo album utility
-;; Copyright (C) 2005 MORIOKA Tomohiko
+;; Copyright (C) 2005,2006 MORIOKA Tomohiko
;; Keywords: Photo, image, album, HTML, WWW
@@ -27,19 +27,19 @@
;;; 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-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-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
@@ -57,7 +57,7 @@
(insert (format "
%s\n" file))
(insert "\n")
(insert "\n")
- (insert (format "%s
\n" file))
+ ;; (insert (format "%s
\n" file))
(if prev-file
(insert (format "" prev-file)))
@@ -141,54 +141,67 @@
(string-to-number (match-string 2))))))
(width (car ret))
(height (cdr ret))
+ (specs '((QVGA 320 240)
+ (VGA 640 480)
+ (SVGA 800 600)
+ (XGA 1024 768)
+ (WXGA 1280 768)
+ (SXGA 1280 1024)
+ (SXGA+ 1400 1050)
+ (WSXGA+ 1680 1050)
+ (UXGA 1600 1200)
+ (WUXGA 1920 1200)
+ (QXGA 2048 1536)
+ (WQXGA 2560 1600)
+ ))
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)))
- (when (setq ret (album-make-spec-by-width width 320 'QVGA))
- (setq dest (cons ret dest)))
- (when (setq ret (album-make-spec-by-width width 160 'thumbnail))
- (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)))
- (when (setq ret (album-make-spec-by-height height 240 'QVGA))
- (setq dest (cons ret dest)))
- (when (setq ret (album-make-spec-by-height height 160 'thumbnail))
- (setq dest (cons ret 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)))
+ ;; (when (setq ret (album-make-spec-by-width width 320 'QVGA))
+ ;; (setq dest (cons ret dest)))
+ ;; (when (setq ret (album-make-spec-by-width width 160 'thumbnail))
+ ;; (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)))
+ ;; (when (setq ret (album-make-spec-by-height height 240 'QVGA))
+ ;; (setq dest (cons ret dest)))
+ ;; (when (setq ret (album-make-spec-by-height height 160 'thumbnail))
+ ;; (setq dest (cons ret dest)))
+ ;; ))
(unless (file-exists-p
(expand-file-name "thumbnail" image-dest-dir))
(make-directory
(expand-file-name "thumbnail" image-dest-dir)))
(call-process "convert" nil nil nil
- "-resize" (format "%d%%" (aref (car dest) 0))
+ "-resize" "160x160>" ; (format "%d%%" (aref (car dest) 0))
file
(expand-file-name
(concat
@@ -197,34 +210,43 @@
(expand-file-name
"thumbnail"
image-dest-dir)))
- (setq rest (cdr dest))
+ (setq rest specs)
+ ;; (setq rest (cdr dest))
(while rest
(setq spec (car rest))
- (album-write-html html-dest-dir
- (if prev-file
- (file-name-sans-extension
- (file-name-nondirectory prev-file)))
+ (when (or (> width (nth 1 spec))
+ (> height (nth 2 spec)))
+ (album-write-html 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
+ (car spec) ; (aref spec 1)
+ (if (nth 1 rest)
+ ;; (aref (nth 1 rest) 1)
+ (car (nth 1 rest))
+ )
+ lang image-url-prefix)
+ (call-process "convert" nil nil nil
+ "-resize" ; (format "%d%%" (aref spec 0))
+ (format "%dx%d>" (nth 1 spec)(nth 2 spec))
+ file
+ (expand-file-name
+ (concat
(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))
- lang image-url-prefix)
- (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))
- image-dest-dir)))
- (setq prev-grade (aref spec 1))
+ (file-name-nondirectory file)) ".jpg")
+ (expand-file-name
+ (symbol-name (car spec) ; (aref spec 1)
+ )
+ image-dest-dir)))
+ ;; (setq prev-grade (aref spec 1))
+ (setq prev-grade (car spec))
+ )
(setq rest (cdr rest)))
(unless (file-exists-p
(expand-file-name "fullsize" image-dest-dir))