160 lines
4.8 KiB
Racket
160 lines
4.8 KiB
Racket
#lang racket
|
|
|
|
(require racket-audio
|
|
"base/booklet-provider.rkt"
|
|
"base/image-provider.rkt"
|
|
"base/tag-data-provider.rkt"
|
|
"track-tag-data.rkt")
|
|
|
|
(provide tag-source-filesystem%
|
|
tag-data-provider-filesystem%
|
|
image-provider-filesystem%
|
|
booklet-provider-filesystem%)
|
|
|
|
(define tag-source-filesystem%
|
|
(class object%
|
|
(init-field file)
|
|
|
|
(define tags
|
|
#f)
|
|
|
|
(define loaded?
|
|
#f)
|
|
|
|
(define/private (read-tags)
|
|
(if (and file (file-exists? file))
|
|
(let* ((source-file
|
|
(if (path? file)
|
|
(path->string file)
|
|
file))
|
|
(source-tags (id3-tags source-file)))
|
|
(if (tags-valid? source-tags)
|
|
source-tags
|
|
(let ((temporary-file
|
|
(make-temporary-file
|
|
"rktplayer-~a"
|
|
#:copy-from source-file)))
|
|
(let ((temporary-tags
|
|
(id3-tags temporary-file)))
|
|
(delete-file temporary-file)
|
|
temporary-tags))))
|
|
#f))
|
|
|
|
(define/public (get-tags)
|
|
(unless loaded?
|
|
(set! tags (read-tags))
|
|
(set! loaded? #t))
|
|
tags)
|
|
|
|
(super-new)))
|
|
|
|
(define tag-data-provider-filesystem%
|
|
(class tag-data-provider%
|
|
(init-field
|
|
tag-source
|
|
[fallback-data (track-tag-data "" "" "" 0 0)])
|
|
|
|
(define tag-data
|
|
#f)
|
|
|
|
(define/override (get-tag-data)
|
|
(unless tag-data
|
|
(let ((tags (send tag-source get-tags)))
|
|
(set! tag-data
|
|
(if (and tags (tags-valid? tags))
|
|
(track-tag-data
|
|
(tags-title tags)
|
|
(tags-artist tags)
|
|
(tags-album tags)
|
|
(tags-track tags)
|
|
(tags-length tags))
|
|
fallback-data))))
|
|
tag-data)
|
|
|
|
(super-new)))
|
|
|
|
(define image-provider-filesystem%
|
|
(class image-provider%
|
|
(init-field file tag-source)
|
|
|
|
(define image-names
|
|
'("cover.jpg" "cover.png" "folder.jpg" "folder.png"))
|
|
|
|
(define/private (image-from-directory)
|
|
(and file
|
|
(let ((directory (path-only file)))
|
|
(for/first ((image-name (in-list image-names))
|
|
#:when
|
|
(file-exists?
|
|
(build-path directory image-name)))
|
|
(build-path directory image-name)))))
|
|
|
|
(define/override (has-image?)
|
|
(let ((tags (send tag-source get-tags)))
|
|
(or (and tags
|
|
(tags-valid? tags)
|
|
(not (eq? (tags-picture->ext tags) #f)))
|
|
(not (eq? (image-from-directory) #f)))))
|
|
|
|
(define/override (image->file target-file)
|
|
(let* ((target (format "~a" target-file))
|
|
(tags (send tag-source get-tags))
|
|
(picture-extension
|
|
(and tags
|
|
(tags-valid? tags)
|
|
(tags-picture->ext tags))))
|
|
(if picture-extension
|
|
(let ((stored-file
|
|
(string-append
|
|
target
|
|
"."
|
|
(symbol->string picture-extension))))
|
|
(and (tags-picture->file tags stored-file)
|
|
stored-file))
|
|
(let ((source-file (image-from-directory)))
|
|
(and source-file
|
|
(let ((stored-file
|
|
(string-append
|
|
target
|
|
(bytes->string/utf-8
|
|
(path-get-extension source-file)))))
|
|
(copy-file source-file
|
|
stored-file
|
|
#:exists-ok? #t)
|
|
(format "~a" stored-file)))))))
|
|
|
|
(define/override (image->mimetype)
|
|
(let ((tags (send tag-source get-tags)))
|
|
(if (and tags
|
|
(tags-valid? tags)
|
|
(not (eq? (tags-picture->ext tags) #f)))
|
|
(tags-picture->mimetype tags)
|
|
(let ((source-file (image-from-directory)))
|
|
(if source-file
|
|
(case (string->symbol
|
|
(string-downcase
|
|
(bytes->string/utf-8
|
|
(path-get-extension source-file))))
|
|
((|.jpg| |.jpeg|) "image/jpeg")
|
|
((|.png|) "image/png")
|
|
(else 'no-mimetype))
|
|
'no-mimetype)))))
|
|
|
|
(super-new)))
|
|
|
|
(define booklet-provider-filesystem%
|
|
(class booklet-provider%
|
|
(init-field file)
|
|
|
|
(define/override (booklet-file)
|
|
(and file
|
|
(build-path (path-only file)
|
|
"booklet.pdf")))
|
|
|
|
(define/override (has-booklet?)
|
|
(let ((booklet (send this booklet-file)))
|
|
(and booklet
|
|
(file-exists? booklet))))
|
|
|
|
(super-new)))
|