From 6128cd44f618a81ea0d1f835ffc9b25b1ec26568 Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Sun, 14 Apr 2024 23:05:48 -0400
Subject: [PATCH] track: woes continue

---
 .gitmodules  |  3 +++
 hsmusic.lisp | 53 ++++++++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 48 insertions(+), 8 deletions(-)
 create mode 100644 .gitmodules

diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..b6c98ad
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "hsmusic-data"]
+	path = hsmusic-data
+	url = https://github.com/hsmusic/hsmusic-data
diff --git a/hsmusic.lisp b/hsmusic.lisp
index d194a2d..83647e5 100644
--- a/hsmusic.lisp
+++ b/hsmusic.lisp
@@ -4,27 +4,64 @@
 (in-package :hsmusic)
 
 (defparameter tracks
-  (loop for path in (directory #p"album/*.yaml")
+  (loop for path in (directory #p"hsmusic-data/album/*.yaml")
         appending (loop for entry in (yaml:parse path :multi-document-p t)
                         when (and (not (symbolp entry)) (gethash "Track" entry))
                           collect entry)))
 
 ; terrible, idc
 ; lossy! (not surprising)
+; upcase for nice interning
 (defun normalize-name (name)
   (ppcre:regex-replace-all
-   "(^track:|\W)"
-   (sb-unicode:normalize-string (string-downcase name) :nfkd)
+   "(^TRACK:|^-+|-+$)"
+   (ppcre:regex-replace-all
+    "[^A-Z0-9]+"
+    (sb-unicode:normalize-string (string-upcase name) :nfkd)
+    "-")
    ""))
 
+;; (defun track-ref-p)
+
+;; (defun track-ref)
+
 (defun track-normalized-name (track)
   (normalize-name (gethash "Track" track)))
 
-(defparameter edges (make-hash-table :test 'equal))
-; (from . to)
-; conceptually, from -> to
+; a -> b <-> a references b
+; screw it! let's use symbols. why not? (LKFDSJKFDJ)
+; it's a finite set it's FINE
+(defparameter -> (make-hash-table))
+(defparameter <- (make-hash-table))
 
 (loop for track in tracks
-      do (let ((name (track-normalized-name track)))
+      do (let ((from-name (intern (track-normalized-name track) :keyword)))
            (loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
-                 do (setf (gethash (cons (normalize-name ref) name) edges) t))))
+                 do (let ((to-name (intern (normalize-name ref) :keyword)))
+                      ; bodge
+                      (unless (eq from-name to-name)
+                        (unionf (gethash from-name ->)   (list to-name))
+                        (unionf (gethash   to-name <-) (list from-name)))))))
+
+(defun tree (src from depth)
+  (let ((succs (gethash from src)))
+    (if (and (plusp depth) (consp succs))
+        (list from (mapcar (lambda (x) (tree src x (- depth 1))) succs))
+        from)))
+
+(defun ->tree (from depth)
+  (tree -> from depth))
+
+(defun <-tree (from depth)
+  (tree <- from depth))
+
+(defun pp-tree (tree &key (stream t) (indent 0) (indent-increment 2))
+  (let ((ind (make-string indent :initial-element #\ )))
+    (if (symbolp tree)
+        (format stream "~a~a~%" ind tree)
+        (destructuring-bind (from tos) tree
+          (format stream "~a~a~%" ind from)
+          (loop for to in tos
+                do (pp-tree to :stream stream
+                               :indent (+ indent indent-increment)
+                               :indent-increment indent-increment))))))