From 98eca7d594960aa616786cbd491b937d50f55499 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 27 Dec 2023 18:21:37 +0100
Subject: First version with 2 songs
---
src/main.lisp | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 150 insertions(+)
create mode 100644 src/main.lisp
(limited to 'src')
diff --git a/src/main.lisp b/src/main.lisp
new file mode 100644
index 0000000..8e47016
--- /dev/null
+++ b/src/main.lisp
@@ -0,0 +1,150 @@
+; Helpers
+
+(defun lines (str)
+ (split str #\linefeed))
+
+(defun split (str c)
+ (loop
+ for i = 0 then (1+ j)
+ as j = (position c str :start i)
+ collect (subseq str i j)
+ while j))
+
+(defun write-file (filename s)
+ (ensure-directories-exist filename)
+ (with-open-file (str filename
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (format str "~A" s)))
+
+; Data
+
+(defun song-key (key song)
+ (let ((tuple (car song)))
+ (cond
+ ((eql tuple nil) nil)
+ ((eql (car tuple) key) (cdr tuple))
+ (t (song-key key (cdr song))))))
+
+; HTML
+
+(defun page (title body)
+ (format
+ nil
+ "~A~A"
+ title
+ body))
+
+(defun h (node attrs children)
+ (format
+ nil
+ "<~A ~A>~A"
+ node
+ (apply #'concatenate 'string (mapcar (lambda (x) (format nil " ~A=\"~A\"" (car x) (car (cdr x)))) attrs))
+ (apply #'concatenate 'string children)
+ node))
+
+; Title
+
+(defun title-tags (title from)
+ (h "section" nil
+ (list
+ (h "h1" '(("class" "g-Title")) (list title))
+ (h "div" '(("class" "g-Author")) (list from)))))
+
+; Part
+
+(defun part-name (key)
+ (ecase key
+ ('intro "Intro")
+ ('verse "Couplet")
+ ('chorus "Refrain")
+ ('interlude "Interlude")))
+
+(defun part-tags (key children)
+ (h "div"
+ '(("class" "g-Part"))
+ (list
+ (if
+ (eql key 'all)
+ nil
+ (h "h3" nil (list (part-name key))))
+ children)))
+
+; Chords
+
+(defun chord-row (chords)
+ (h "tr" nil (mapcar (lambda (x) (h "td" nil (list (string x)))) chords)))
+
+(defun chord-rows (xs)
+ (if
+ (eql xs nil)
+ nil
+ (cons (chord-row (car xs)) (chord-rows (cdr xs)))))
+
+(defun chord-table (key row)
+ (part-tags
+ key
+ (h "table" '(("class" "g-Chords")) (chord-rows row))))
+
+(defun chord-tables (xs)
+ (if
+ (eql xs nil)
+ nil
+ (let ((key (car (car xs)))
+ (rows (cdr (car xs))))
+ (cons (chord-table key rows) (chord-tables (cdr xs))))))
+
+(defun chord-tags (chords)
+ (h "section" nil
+ (list
+ (h "h2" '(("class" "g-Subtitle")) '("Accords"))
+ (h "div" '(("class" "g-Parts")) (chord-tables chords)))))
+
+; Lyrics
+
+(defun emph (str cs)
+ (apply #'concatenate 'string
+ (loop for c across str collect
+ (if (member c cs) (h "emph" nil (list (make-string 1 :initial-element c))) (make-string 1 :initial-element c)))))
+
+(defun lyrics-line (line)
+ (h "div" nil (list (emph line (list #\, #\. #\? #\!)))))
+
+(defun lyrics-section (s)
+ (let ((p (car (cdr s))))
+ (part-tags
+ (car s)
+ (if p
+ (h "div" '(("class" "g-Lyrics__Paragraph")) (mapcar #'lyrics-line (lines p)))
+ nil))))
+
+(defun lyrics-tags (lyrics)
+ (h "section" nil
+ (list
+ (h "h2" '(("class" "g-Subtitle")) '("Paroles"))
+ (h "div" '(("class" "g-Parts")) (mapcar #'lyrics-section lyrics)))))
+
+; Main
+
+(defun export-song (path)
+ (let ((data (with-open-file (in path) (read in))))
+ (let ((output (concatenate 'string "public/" (car (split path #\.)) ".html"))
+ (title (car (song-key 'title (cdr data))))
+ (from (car (song-key 'from (cdr data))))
+ (chords (song-key 'chords (cdr data)))
+ (lyrics (song-key 'lyrics (cdr data))))
+ (write-file output (page
+ (format nil "~A – ~A" title from)
+ (h
+ "body"
+ nil
+ (list
+ (h "a" '(("class" "g-Back") ("href" "/")) '("Retour à l’accueil"))
+ (title-tags title from)
+ (chord-tags chords)
+ (lyrics-tags lyrics))))))))
+
+(export-song "songs/graeme-allwright/petit-garcon.lisp")
+(export-song "songs/ben-e-king/stand-by-me.lisp")
--
cgit v1.2.3