77 lines
1.7 KiB
Scheme
77 lines
1.7 KiB
Scheme
(define (flatten l)
|
|
(cond
|
|
((not (list? l)) l)
|
|
((null? l) '())
|
|
((list? (car l)) (append (flatten (car l)) (flatten (cdr l))))
|
|
(#t (cons (car l) (flatten (cdr l))))))
|
|
|
|
|
|
(define (tree path)
|
|
(cond
|
|
((file-directory? path)
|
|
(map (lambda (item) (tree (string-append path "/" item))) (directory-list path)))
|
|
(#t 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 (albumize path)
|
|
`(html ()
|
|
(head ()
|
|
(meta (charset "utf-8"))
|
|
(style () "
|
|
img {
|
|
display:block;
|
|
max-width: 100%;
|
|
margin: auto;
|
|
padding: 10px;
|
|
}
|
|
"))
|
|
,(cons 'body (cons '() (map (lambda (filename) `(img (src ,filename))) (pictures path))))))
|
|
|
|
(define (list->attr l)
|
|
(cond
|
|
((null? l) "")
|
|
(#t (string-append (format " ~A=\"~A\"" (car l) (cadr l)) (list->attr (cddr l))))))
|
|
|
|
(define (list->inner-html l)
|
|
(apply
|
|
string-append
|
|
(map
|
|
(lambda (v)
|
|
(cond
|
|
((list? v) (sexpr->html v))
|
|
(#t (format "~A" v))))
|
|
l)))
|
|
|
|
(define (sexpr->html s)
|
|
(cond
|
|
((null? (cddr s)) ; self-closing tag
|
|
(format "<~A~A/>~%" (car s) (list->attr (cadr s))))
|
|
(#t ; non self-closing tag
|
|
(string-append
|
|
; opening tag
|
|
(format "<~A~A>~%" (car s) (list->attr (cadr s)))
|
|
; inner content
|
|
(list->inner-html (cddr s))
|
|
; closing tag
|
|
(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)
|
|
)))
|
|
|