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

Convert pictures and use an output folder

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))))
(#t (cons (car l) (flatten (cdr l))))))
(define (tree path)
(define (file-tree path)
(cond
((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)))
(define (file-list path) (sort string<=? (flatten (file-tree path))))
(define (string-suffix s n)
(let ([strlen (string-length s)])
(substring s (- strlen n) strlen)))
(define (pictures path)
(sort
string<=?
(filter
(lambda (filename) (string=? ".JPG" (string-suffix filename 4)))
(flatten (tree path)))))
(define (filter-ext fl ext)
(filter
(lambda (filename) (string=? ext (string-suffix filename (string-length ext))))
fl))
(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 ()
(head ()
(meta (charset "utf-8"))
(style () "
img {
display:block;
max-width: 100%;
max-width: calc(100% - 20px);
margin: auto;
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)
(cond
@ -67,10 +87,18 @@ img {
(format "</~A>~%" (car s))))
))
(define (build src-folder dest-file)
(call-with-output-file
dest-file
(lambda (p)
(display (sexpr->html (albumize src-folder)) p)
)))
(define (pic-list src out slug)
(cond
((file-exists? out) (webp out))
(#t (mkdir out) (reverse (import-pictures (jpg src) out slug)))))
(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)
))))