From: tomo Date: Tue, 7 Mar 2006 12:08:47 +0000 (+0000) Subject: (album-write-html): Add new optional argument `image-url'. X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Falbum.git;a=commitdiff_plain;h=6ea01857099cd79049ed2ac1811068865fbc6b37 (album-write-html): Add new optional argument `image-url'. (album-make-selection-1): New function. (album-make-selection): New function. --- diff --git a/album.el b/album.el index b332307..a50670b 100644 --- a/album.el +++ b/album.el @@ -27,24 +27,11 @@ ;;; 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 - lang image-url-prefix) + lang image-url-prefix + &optional image-url) (with-temp-buffer (insert "") - (insert (format "\"%s\"" - file + (insert (format "\"%s\"" + (or image-url + (concat file ".jpg")) (if image-url-prefix - (format "%s/%s/%s" - image-url-prefix grade file) - file))) + (format "%s%s/%s" + (file-name-as-directory image-url-prefix) + grade + (or image-url file)) + (or image-url (concat file ".jpg"))))) (insert "
@@ -156,52 +150,12 @@ )) 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))) - ;; )) (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" "160x160>" ; (format "%d%%" (aref (car dest) 0)) + "-resize" "160x160>" file (expand-file-name (concat @@ -211,7 +165,6 @@ "thumbnail" image-dest-dir))) (setq rest specs) - ;; (setq rest (cdr dest)) (while rest (setq spec (car rest)) (when (or (> width (nth 1 spec)) @@ -233,20 +186,16 @@ ) 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)) + "-resize" (format "%dx%d>" (nth 1 spec)(nth 2 spec)) file (expand-file-name (concat (file-name-sans-extension (file-name-nondirectory file)) ".jpg") (expand-file-name - (symbol-name (car spec) ; (aref spec 1) - ) + (symbol-name (car spec)) image-dest-dir))) - ;; (setq prev-grade (aref spec 1)) - (setq prev-grade (car spec)) - ) + (setq prev-grade (car spec))) (setq rest (cdr rest))) (unless (file-exists-p (expand-file-name "fullsize" image-dest-dir)) @@ -360,6 +309,77 @@ lang title parent-url image-url-prefix html-dest-dir))) +(defun album-make-selection-1 (image-dest-dir + prev-file file next-file + lang image-url-prefix + html-dest-dir + &optional image-url-spec) + (setq file (expand-file-name file)) + (unless html-dest-dir + (setq html-dest-dir image-dest-dir)) + (let* ((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) + (setq rest specs) + (while rest + (setq spec (car rest)) + (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) + (if (nth 1 rest) + (car (nth 1 rest))) + lang + (if image-url-spec + (nth 1 image-url-spec) + image-url-prefix) + (if image-url-spec + (nth 2 image-url-spec)) + ) + (setq prev-grade (car spec)) + (setq rest (cdr rest))) + dest)) + +(defun album-make-selection (image-dest-dir source-images + &optional lang title parent-url + image-url-prefix html-dest-dir) + (unless html-dest-dir + (setq html-dest-dir image-dest-dir)) + ;; (album-make-thumbnails html-dest-dir source-images + ;; lang title image-url-prefix parent-url) + (let ((i 1) + image-url-spec prev-file) + (while source-images + (setq image-url-spec (car source-images)) + (setq file (format "%d" i)) + (album-make-selection-1 image-dest-dir + prev-file file (if (nth 1 source-images) + (format "%d" (1+ i))) + lang image-url-prefix html-dest-dir + image-url-spec) + (setq prev-file file + source-images (cdr source-images)) + (setq i (1+ i))))) + (provide 'album)