;;; 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
(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))
projects / elisp / album.git / blobdiff