;;; 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
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
(insert
(if next-grade
(format "../%s/%s.html" next-grade file)
- (concat "../fullsize/" file ".jpg")))
+ (if image-url
+ (concat (file-name-as-directory image-url-prefix)
+ "fullsize/"
+ image-url)
+ (concat "../fullsize/" file ".jpg"))))
(insert "\">")
- (insert (format "<img alt=\"%s\" src=\"%s.jpg\">"
- file
+ (insert (format "<img alt=\"%s\" src=\"%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 "</a>
<hr>
))
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
"thumbnail"
image-dest-dir)))
(setq rest specs)
- ;; (setq rest (cdr dest))
(while rest
(setq spec (car rest))
(when (or (> width (nth 1 spec))
)
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))
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)
projects / elisp / album.git / commitdiff