68 lines
2.3 KiB
Common Lisp
68 lines
2.3 KiB
Common Lisp
(ql:quickload '(:cl-yaml :alexandria :cl-ppcre))
|
|
(defpackage :hsmusic
|
|
(:use :common-lisp :alexandria))
|
|
(in-package :hsmusic)
|
|
|
|
(defparameter tracks
|
|
(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:|^-+|-+$)"
|
|
(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)))
|
|
|
|
; 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 ((from-name (intern (track-normalized-name track) :keyword)))
|
|
(loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
|
|
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))))))
|