hans/rktplayer
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-08 14:29:01 +02:00
parent 186b3bb8d7
commit f5fdc38e67
69 changed files with 5953 additions and 1647 deletions
Download Patch File Download Diff File Expand all files Collapse all files
library/base/booklet-provider.rkt
+12
View File
@@ -0,0 +1,12 @@
#lang racket/base
(require racket/class)
(provide booklet-provider%)
(define booklet-provider%
(class object%
(abstract
has-booklet?
booklet-file)
(super-new)))
library/base/image-provider.rkt
+13
View File
@@ -0,0 +1,13 @@
#lang racket/base
(require racket/class)
(provide image-provider%)
(define image-provider%
(class object%
(abstract
has-image?
image->file
image->mimetype)
(super-new)))
library/base/media-container.rkt
+52
View File
@@ -0,0 +1,52 @@
#lang racket/base
(require racket/class
"media-item.rkt")
(provide media-container%)
;; A media container contains media-item% instances. An item can itself be
;; another media-container%, or it can be a track<%>.
(define media-container%
(class media-item%
(init [id #f])
(super-new
[id id]
[kind 'container])
(abstract
get-title
get-items
get-track-reliver)))
(module+ test
(require rackunit)
(define track-reliver
(lambda (track-factory-id track-relive-info)
(list track-factory-id track-relive-info)))
(define test-container%
(class media-container%
(super-new [id 'container-id])
(define/override (get-title)
"Container")
(define/override (get-items)
'())
(define/override (get-track-reliver)
track-reliver)))
(define container
(new test-container%))
(check-equal? (send container get-id) 'container-id)
(check-equal? (send container get-kind) 'container)
(check-eq? (send container get-container) container)
(check-false (send container get-track))
(check-equal? (send container get-title) "Container")
(check-equal? (send container get-items) '())
(check-eq? (send container get-track-reliver) track-reliver))
library/base/media-item.rkt
+59
View File
@@ -0,0 +1,59 @@
#lang racket/base
(require racket/class)
(provide media-item%)
;; Common base class for entries returned by a media container.
(define media-item%
(class object%
(init-field
kind
[id #f])
(unless (memq kind '(container track))
(raise-arguments-error
'media-item%
"invalid media item kind"
"expected" '(container track)
"kind" kind))
(define/public (get-id)
id)
(define/public (get-kind)
kind)
(define/public (get-container)
(and (eq? kind 'container)
this))
(define/public (get-track)
(and (eq? kind 'track)
this))
(super-new)))
(module+ test
(require rackunit)
(define container
(new media-item%
[id 'container-id]
[kind 'container]))
(define track
(new media-item%
[id 'track-id]
[kind 'track]))
(check-eq? (send container get-container) container)
(check-false (send container get-track))
(check-eq? (send track get-track) track)
(check-false (send track get-container))
(check-equal? (send container get-id) 'container-id)
(check-equal? (send track get-kind) 'track)
(check-exn
exn:fail:contract?
(lambda ()
(new media-item% [kind 'unknown]))))
library/base/media-library.rkt
+51
View File
@@ -0,0 +1,51 @@
#lang racket/base
(require racket/class
"../library-cfg.rkt"
"../../misc/utils.rkt")
(provide media-library%)
(define media-library%
(class object%
(init-field
cfg)
(check/c media-library%
cfg
(is-a?/c library-cfg%))
(define cfg-revision
-1)
(define root-container
#f)
(define/private (reset-if-needed!)
(let ((current-revision (send cfg get-revision)))
(unless (= cfg-revision current-revision)
(set! cfg-revision current-revision)
(set! root-container #f))))
(define/public (get-cfg)
cfg)
(define/public (get-id)
(send cfg get-id))
(define/public (get-kind)
(send cfg get-kind))
(define/public (get-kind-version)
(send cfg get-kind-version))
(define/public (get-root-container)
(reset-if-needed!)
(when (eq? root-container #f)
(set! root-container
(send this make-root-container)))
root-container)
(abstract make-root-container)
(super-new)))
library/base/media-resource.rkt
+97
View File
@@ -0,0 +1,97 @@
#lang racket/base
(require net/url
racket/class
racket/string
"../../misc/utils.rkt")
(provide media-resource%
media-resource-file%)
(define media-resource%
(class object%
(init-field
uri
mime-type
protocol-info
seekable?)
(check/c* media-resource%
(uri string?)
(mime-type (or/c #f string?))
(protocol-info (or/c #f string?))
(seekable? boolean?))
(define/public (get-uri)
uri)
(define/public (get-mime-type)
mime-type)
(define/public (get-protocol-info)
protocol-info)
(define/public (is-seekable?)
seekable?)
(define/public (get-file)
#f)
(super-new)))
(define media-resource-file%
(class media-resource%
(init
file
mime-type
[seekable? #t])
(check/c media-resource-file%
file
(or/c path? string?))
(define resource-file
(normal-case-path
(path->complete-path file)))
(define/override (get-file)
resource-file)
(super-new
[uri
(url->string
(path->url resource-file))]
[mime-type mime-type]
[protocol-info
(and mime-type
(format "file:*:~a:*" mime-type))]
[seekable? seekable?])))
(module+ test
(require rackunit)
(define resource
(new media-resource-file%
[file
(build-path
(find-system-path 'temp-dir)
"track.flac")]
[mime-type "audio/flac"]))
(check-true
(is-a? resource media-resource%))
(check-true
(is-a? resource media-resource-file%))
(check-true
(path? (send resource get-file)))
(check-true
(string-prefix? (send resource get-uri)
"file:"))
(check-equal?
(send resource get-mime-type)
"audio/flac")
(check-equal?
(send resource get-protocol-info)
"file:*:audio/flac:*")
(check-true
(send resource is-seekable?)))
library/base/tag-data-provider.rkt
+10
View File
@@ -0,0 +1,10 @@
#lang racket/base
(require racket/class)
(provide tag-data-provider%)
(define tag-data-provider%
(class object%
(abstract get-tag-data)
(super-new)))
library/base/track.rkt
+205
View File
@@ -0,0 +1,205 @@
#lang racket/base
(require racket/class
"booklet-provider.rkt"
"image-provider.rkt"
"media-item.rkt"
"media-resource.rkt"
"tag-data-provider.rkt"
"../track-tag-data.rkt"
"../../misc/utils.rkt")
(provide track<%>
track%)
(define track<%>
(interface ((class->interface media-item%))
get-title
get-artist
get-album
get-number
get-length
get-resource
get-music-library-factory-id
get-track-factory-id
get-track-relive-info
has-image?
image->file
image->mimetype
has-booklet?
booklet-file
track<
->log))
(define next-track-id
0)
(define (new-track-id)
(set! next-track-id (+ next-track-id 1))
(when (> next-track-id 10000000)
(set! next-track-id 1))
next-track-id)
(define track%
(class* media-item% (track<%>)
(init
tag-data-provider
image-provider
booklet-provider
resource
[id #f]
[music-library-factory-id #f]
[track-factory-id #f]
[track-relive-info #f])
(check/c* track%
(tag-data-provider
(is-a?/c tag-data-provider%))
(image-provider
(is-a?/c image-provider%))
(booklet-provider
(is-a?/c booklet-provider%))
(resource
(is-a?/c media-resource%)))
(define the-tag-data-provider
tag-data-provider)
(define the-image-provider
image-provider)
(define the-booklet-provider
booklet-provider)
(define the-resource
resource)
(define the-music-library-factory-id
music-library-factory-id)
(define the-track-factory-id
track-factory-id)
(define the-track-relive-info
track-relive-info)
(define/private (get-tag-data)
(send the-tag-data-provider get-tag-data))
(define/public (get-title)
(track-tag-data-title (get-tag-data)))
(define/public (get-artist)
(track-tag-data-artist (get-tag-data)))
(define/public (get-album)
(track-tag-data-album (get-tag-data)))
(define/public (get-number)
(track-tag-data-number (get-tag-data)))
(define/public (get-length)
(track-tag-data-length (get-tag-data)))
(define/public (get-resource)
the-resource)
(define/public (get-music-library-factory-id)
the-music-library-factory-id)
(define/public (get-track-factory-id)
the-track-factory-id)
(define/public (get-track-relive-info)
the-track-relive-info)
(define/public (has-image?)
(send the-image-provider has-image?))
(define/public (image->file target-file)
(send the-image-provider image->file target-file))
(define/public (image->mimetype)
(send the-image-provider image->mimetype))
(define/public (has-booklet?)
(send the-booklet-provider has-booklet?))
(define/public (booklet-file)
(send the-booklet-provider booklet-file))
(define/public (track< other-track)
(if (string-ci<? (send this get-album)
(send other-track get-album))
#t
(and (string-ci=? (send this get-album)
(send other-track get-album))
(< (send this get-number)
(send other-track get-number)))))
(define/public (->log)
(info-rktplayer "~a - ~a - ~a - ~a"
(send this get-number)
(send this get-title)
(send this get-album)
(send this get-length)))
(super-new
[id (if id id (new-track-id))]
[kind 'track])))
(module+ test
(require rackunit)
(define test-tag-data-provider%
(class tag-data-provider%
(define/override (get-tag-data)
(track-tag-data
"Title"
"Artist"
"Album"
2
120))
(super-new)))
(define test-image-provider%
(class image-provider%
(define/override (has-image?) #f)
(define/override (image->file target-file) #f)
(define/override (image->mimetype) 'no-mimetype)
(super-new)))
(define test-booklet-provider%
(class booklet-provider%
(define/override (has-booklet?) #f)
(define/override (booklet-file) #f)
(super-new)))
(define resource
(new media-resource%
[uri "https://example.com/track.flac"]
[mime-type "audio/flac"]
[protocol-info "http-get:*:audio/flac:*"]
[seekable? #t]))
(define track
(new track%
[resource resource]
[tag-data-provider
(new test-tag-data-provider%)]
[image-provider
(new test-image-provider%)]
[booklet-provider
(new test-booklet-provider%)]))
(check-true (is-a? track track%))
(check-true (is-a? track track<%>))
(check-equal? (send track get-kind) 'track)
(check-equal? (send track get-title) "Title")
(check-equal? (send track get-artist) "Artist")
(check-equal? (send track get-album) "Album")
(check-equal? (send track get-number) 2)
(check-equal? (send track get-length) 120)
(check-eq? (send track get-resource) resource)
(check-false (send track has-image?))
(check-false (send track has-booklet?)))