(album-make-spec-by-width): Abolished.
authortomo <tomo>
Tue, 21 Feb 2006 20:12:35 +0000 (20:12 +0000)
committertomo <tomo>
Tue, 21 Feb 2006 20:12:35 +0000 (20:12 +0000)
(album-make-spec-by-height): Abolished.
(album-convert-image): New implementation.

album.el

index caa2201..b332307 100644 (file)
--- 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
 
 
 ;;; 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 "<title>%s</title>\n" file))
     (insert "</head>\n")
     (insert "<body>\n")
-    (insert (format "<h1>%s</h1>\n" file))
+    ;; (insert (format "<h1>%s</h1>\n" file))
 
     (if prev-file
        (insert (format "<a href=\"%s.html\">" prev-file)))
                       (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
                   (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))