From c40e1ae89c643acd6be84c2d7be534fd741a400a Mon Sep 17 00:00:00 2001 From: tomo Date: Tue, 21 Feb 2006 20:12:35 +0000 Subject: [PATCH 1/1] (album-make-spec-by-width): Abolished. (album-make-spec-by-height): Abolished. (album-convert-image): New implementation. --- album.el | 182 +++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 102 insertions(+), 80 deletions(-) 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)) -- 1.7.10.4