quentin/interactive-prog
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Convert pictures and use an output folder

Browse source
This commit is contained in:
Quentin 2022-07-22 23:29:27 +02:00
parent 4815462e89
commit eb14a54598
Signed by: quentin
GPG key ID: E9602264D639FF68
1 changed files with 46 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
album.ss
View file

@ -5,38 +5,58 @@
((list? (car l)) (append (flatten (car l)) (flatten (cdr l)))) ((list? (car l)) (append (flatten (car l)) (flatten (cdr l))))
(#t (cons (car l) (flatten (cdr l)))))) (#t (cons (car l) (flatten (cdr l))))))
(define (file-tree path)
(define (tree path)
(cond (cond
((file-directory? path) ((file-directory? path)
(map (lambda (item) (tree (string-append path "/" item))) (directory-list path))) (map (lambda (item) (file-tree (string-append path "/" item))) (directory-list path)))
(#t path))) (#t path)))
(define (file-list path) (sort string<=? (flatten (file-tree path))))
(define (string-suffix s n) (define (string-suffix s n)
(let ([strlen (string-length s)]) (let ([strlen (string-length s)])
(substring s (- strlen n) strlen))) (substring s (- strlen n) strlen)))
(define (pictures path) (define (filter-ext fl ext)
(sort (filter
string<=? (lambda (filename) (string=? ext (string-suffix filename (string-length ext))))
(filter fl))
(lambda (filename) (string=? ".JPG" (string-suffix filename 4)))
(flatten (tree path)))))
(define (jpg path) (filter-ext (file-list path) ".JPG"))
(define (webp path) (filter-ext (file-list path) ".webp"))
(define (albumize path) (define convert "/nix/store/rxxvsvf5p41p83k43cj0mibhymjzvkpk-imagemagick-7.1.0-37/bin/convert")
(define (import-picture src dest)
(system (string-append convert " " src " -resize 1600x1600\\> " dest)))
(define (import-pictures src-list dest-path album-slug . cnt)
(cond
((null? cnt) (import-pictures (reverse src-list) dest-path album-slug (length src-list)))
((null? src-list) '())
(#t (let ([newname (string-append dest-path "/" album-slug (format "~6,,,'0@A" (car cnt)) ".webp")])
(display (format "processing ~A ~%" (car src-list)))
(import-picture (car src-list) newname)
(cons newname (import-pictures
(cdr src-list)
dest-path
album-slug
(- (car cnt) 1)))
))))
(define (albumize pl)
`(html () `(html ()
(head () (head ()
(meta (charset "utf-8")) (meta (charset "utf-8"))
(style () " (style () "
img { img {
display:block; display:block;
max-width: 100%; max-width: calc(100% - 20px);
margin: auto; margin: auto;
padding: 10px; padding: 10px;
} }
")) "))
,(cons 'body (cons '() (map (lambda (filename) `(img (src ,filename))) (pictures path)))))) ,(cons 'body (cons '() (map (lambda (filepath) `(img (src ,(path-last filepath) loading "lazy"))) pl)))))
(define (list->attr l) (define (list->attr l)
(cond (cond
@ -67,10 +87,18 @@ img {
(format "</~A>~%" (car s)))) (format "</~A>~%" (car s))))
)) ))
(define (build src-folder dest-file) (define (pic-list src out slug)
(call-with-output-file (cond
dest-file ((file-exists? out) (webp out))
(lambda (p) (#t (mkdir out) (reverse (import-pictures (jpg src) out slug)))))
(display (sexpr->html (albumize src-folder)) p)
))) (define (build src out slug)
(let ([pl (pic-list src out slug)])
(call-with-output-file
(string-append out "/index.html")
(lambda (p)
(display "<!doctype html>" p)
(newline p)
(display (sexpr->html (albumize pl)) p)
))))