gallery-builder.scm 1.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. (define-module (builders gallery-builder)
  2. #:use-module (theme theme)
  3. #:use-module (haunt site)
  4. #:use-module (haunt post)
  5. #:use-module (haunt page)
  6. #:use-module (haunt html)
  7. #:use-module (haunt utils)
  8. #:use-module (utils utils)
  9. #:use-module (ice-9 match)
  10. #:use-module (ice-9 ftw)
  11. #:declarative? #f
  12. #:export (gallery-builder))
  13. ;; my pages builder cannot render pages the same way that my-blog
  14. ;; builder does. my blog builder renders posts, because it gets a
  15. ;; list of posts. However, my pages are NOT posts.
  16. ;; Builders are procedures that return one or more page objects (*note
  17. ;; Pages::) when applied. A builder accepts two arguments: A site
  18. ;; (*note Sites:: and a list of posts (*note Posts::).
  19. (define remove-stat
  20. ;; Remove the `stat' object the `file-system-tree' provides
  21. ;; for each file in the tree.
  22. (match-lambda
  23. ((name stat) ; flat file
  24. name)
  25. ((name stat children ...) ; directory
  26. (list name (map remove-stat children)))))
  27. (define (gallery-images-list)
  28. (car
  29. (cdr
  30. (let ([dir "./images/gallery/"])
  31. (remove-stat (file-system-tree dir))))))
  32. (define (gallery-images-html list)
  33. (let loop ([list list])
  34. (if (null? list)
  35. '()
  36. `((img (@ (src ,(string-append "./images/gallery/" (car list)) )))
  37. ,(loop (cdr list))))))
  38. (define (gallery-builder)
  39. (lambda (site posts)
  40. (make-page "gallery.html"
  41. (gnucode-layout site "Gallery"
  42. `((div (@ (class "gallery-flex"))
  43. ,(gallery-images-html (gallery-images-list))
  44. )))
  45. sxml->html)))