diff options
| author | Joris | 2023-12-27 18:21:37 +0100 |
|---|---|---|
| committer | Joris | 2023-12-27 18:21:37 +0100 |
| commit | 98eca7d594960aa616786cbd491b937d50f55499 (patch) | |
| tree | db63132d159d09bed2b0a6454c822c2ed95091c6 /src | |
| parent | 57da196f828352b009ca86dca98e352cf09663f3 (diff) | |
First version with 2 songs
Diffstat (limited to 'src')
| -rw-r--r-- | src/main.lisp | 150 |
1 files changed, 150 insertions, 0 deletions
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 + "<!doctype html><html lang=\"fr\"><meta charset=\"utf-8\"><meta name=\"viewport\" content=\"width=device-width\"><title>~A</title><link rel=\"stylesheet\" href=\"/main.css\"><link rel=\"icon\" href=\"/icon.png\">~A" + title + body)) + +(defun h (node attrs children) + (format + nil + "<~A ~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") |