ini file support and cover art
This commit is contained in:
+98
-13
@@ -10,9 +10,11 @@
|
||||
(provide (struct-out music-library)
|
||||
(struct-out browser-entry)
|
||||
(struct-out track)
|
||||
(struct-out artwork)
|
||||
make-music-libraries
|
||||
browse-library
|
||||
browser-entry->tracks)
|
||||
browser-entry->tracks
|
||||
track-artwork)
|
||||
|
||||
(struct music-library
|
||||
(id name root)
|
||||
@@ -26,6 +28,10 @@
|
||||
(file title artist album duration mime-type)
|
||||
#:transparent)
|
||||
|
||||
(struct artwork
|
||||
(mime-type data)
|
||||
#:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -33,6 +39,11 @@
|
||||
(define supported-extensions
|
||||
(audio-supported-extensions))
|
||||
|
||||
(define cover-file-names
|
||||
'("cover.jpg" "cover.jpeg" "cover.png"
|
||||
"folder.jpg" "folder.jpeg" "folder.png"
|
||||
"front.jpg" "front.jpeg" "front.png"))
|
||||
|
||||
(define (audio-file? file)
|
||||
(let ((extension (path-get-extension file)))
|
||||
(and extension
|
||||
@@ -128,20 +139,38 @@
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Turn configured directory paths into music libraries.
|
||||
; pre : Every value is a path-string naming an existing directory.
|
||||
; pre : Every value is a path or a (display-name path) list.
|
||||
; post : No directory contents or audio metadata have been read.
|
||||
; result : Libraries in configuration order, without duplicate roots.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (make-music-libraries paths)
|
||||
(define (make-music-libraries specifications)
|
||||
(define (specification-values specification)
|
||||
(if (and (list? specification)
|
||||
(= (length specification) 2)
|
||||
(string? (car specification))
|
||||
(path-string? (cadr specification)))
|
||||
(values (string-trim (car specification))
|
||||
(cadr specification))
|
||||
(if (path-string? specification)
|
||||
(values #f specification)
|
||||
(raise-argument-error
|
||||
'make-music-libraries
|
||||
"(or/c path-string? (list/c string? path-string?))"
|
||||
specification))))
|
||||
(let ((roots
|
||||
(remove-duplicates
|
||||
(map (λ (path)
|
||||
(normal-case-path
|
||||
(path->complete-path path)))
|
||||
paths)
|
||||
equal?)))
|
||||
(for/list ((root (in-list roots))
|
||||
(for/list ((specification (in-list specifications)))
|
||||
(let-values (((name path)
|
||||
(specification-values specification)))
|
||||
(list name
|
||||
(normal-case-path
|
||||
(path->complete-path path)))))
|
||||
(lambda (first second)
|
||||
(equal? (cadr first) (cadr second))))))
|
||||
(for/list ((named-root (in-list roots))
|
||||
(index (in-naturals)))
|
||||
(define configured-name (car named-root))
|
||||
(define root (cadr named-root))
|
||||
(unless (directory-exists? root)
|
||||
(raise-arguments-error
|
||||
'make-music-libraries
|
||||
@@ -150,11 +179,56 @@
|
||||
(let ((name (file-name-from-path root)))
|
||||
(music-library
|
||||
(format "library-~a" index)
|
||||
(if name
|
||||
(path->string name)
|
||||
(path->string root))
|
||||
(if (and configured-name
|
||||
(not (string=? configured-name "")))
|
||||
configured-name
|
||||
(if name
|
||||
(path->string name)
|
||||
(path->string root)))
|
||||
root)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Read the artwork associated with a track.
|
||||
; pre : Item names a local audio file.
|
||||
; post : The audio file and optional neighbouring image remain unchanged.
|
||||
; result : Embedded artwork, a conventional folder cover, or #f.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (track-artwork item)
|
||||
(define embedded
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(call-with-id3-tags
|
||||
(track-file item)
|
||||
(λ (tags)
|
||||
(let ((picture (and (tags-valid? tags)
|
||||
(tags-picture tags))))
|
||||
(and picture
|
||||
(artwork (let ((mime (id3-picture-mimetype picture)))
|
||||
(if (and (string? mime)
|
||||
(not (string=? mime "")))
|
||||
mime
|
||||
"application/octet-stream"))
|
||||
(id3-picture-bytes picture))))))))
|
||||
(or embedded
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(let* ((directory (or (path-only (track-file item))
|
||||
(current-directory)))
|
||||
(cover
|
||||
(findf
|
||||
(λ (candidate)
|
||||
(let ((name (file-name-from-path candidate)))
|
||||
(and name
|
||||
(file-exists? candidate)
|
||||
(member (path->string name)
|
||||
cover-file-names
|
||||
string-ci=?))))
|
||||
(directory-list directory #:build? #t))))
|
||||
(and cover
|
||||
(let ((mime (mimetype-for-ext cover)))
|
||||
(artwork (if (string? mime)
|
||||
mime
|
||||
"application/octet-stream")
|
||||
(file->bytes cover))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : List the immediate folders and supported audio files in a library.
|
||||
; pre : Relative-path was produced by a previous browse result.
|
||||
@@ -217,6 +291,17 @@
|
||||
(check-equal? (browser-entry-name (car entries)) "Album")
|
||||
(check-eq? (browser-entry-kind (car entries)) 'container)
|
||||
(check-equal? (browser-entry-name (cadr entries)) "track.mp3")
|
||||
(check-eq? (browser-entry-kind (cadr entries)) 'track)))
|
||||
(check-eq? (browser-entry-kind (cadr entries)) 'track)
|
||||
(check-equal?
|
||||
(music-library-name
|
||||
(car (make-music-libraries
|
||||
(list (list "Luisterkamer" root)))))
|
||||
"Luisterkamer")
|
||||
(check-equal?
|
||||
(artwork-mime-type
|
||||
(track-artwork
|
||||
(track (build-path root "track.mp3")
|
||||
"Track" "" "" #f "audio/mpeg")))
|
||||
"image/jpeg")))
|
||||
(λ ()
|
||||
(delete-directory/files root))))
|
||||
|
||||
Reference in New Issue
Block a user