commit 647ee4852c47d3d5fe382b7a8db41f835cebf2e3
parent 831f048e6ed57c161b537be4dff7c3bc130ce8b1
Author: Adriel Dumas--Jondeau <leirda@disroot.org>
Date: Fri, 24 May 2024 14:26:44 +0200
Ajoute les fonctions utilisés partout ailleurs dans le site
Le fichier utils définit notamment les urls courantes, la logique pour
charger les SVG, etc.
Diffstat:
| A | duper.scm | | | 41 | +++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 41 insertions(+), 0 deletions(-)
diff --git a/duper.scm b/duper.scm
@@ -0,0 +1,41 @@
+(define-module (duper)
+ #:use-module (ice-9 textual-ports)
+ #:use-module (sxml match)
+ #:use-module (sxml simple))
+
+(define (url to desc)
+ `(ul (li (a (@ (href ,to)) ,desc))))
+
+(define (svg-uns sxml)
+ (sxml-match sxml
+ ((ns:svg (@ . ,a) . ,r) `(svg (@ ,@a) ,(map svg-uns r)))
+ ((ns:defs (@ . ,a) . ,r) `(defs (@ ,@a) ,(map svg-uns r)))
+ ((ns:style (@ . ,a) . ,r) `(style (@ ,@a) ,(map svg-uns r)))
+ ((ns:g (@ . ,a) . ,r) `(g (@ ,@a) ,(map svg-uns r)))
+ ((ns:path (@ . ,a) . ,r) `(path (@ ,@a) ,(map svg-uns r)))
+ (,default default)))
+
+(define (load-svg path)
+ (let* ((ns "http://www.w3.org/2000/svg")
+ (sxml (with-input-from-file path
+ (lambda () (xml->sxml #:namespaces
+ `((ns . ,ns)))))))
+ (svg-uns (caddr sxml))))
+
+(define-public mail
+ "contact@duché-perché.fr")
+
+(define-public sxml-logo
+ (sxml-match (load-svg "assets/logo.svg")
+ ((svg (@ . ,a) . ,r) `(svg (@ (class "logo") ,@a) ,r))))
+
+(define-public sxml-blason
+ (load-svg "assets/blason.svg"))
+
+(define-public url-geo
+ (url "https://osm.org/go/0AyeOPWT1-?m="
+ "afficher sur la carte"))
+
+(define-public url-mailto
+ (url (string-append "mailto:" mail)
+ mail))
