Initial import
This commit is contained in:
@@ -0,0 +1,195 @@
|
||||
#lang racket/base
|
||||
|
||||
;; Device-oriented convenience interface for UPnP/DLNA media renderers.
|
||||
;;
|
||||
;; This layer hides AVTransport and RenderingControl for common playback and
|
||||
;; volume operations. The underlying device value remains an upnp-device, so
|
||||
;; generic service inspection is still possible.
|
||||
|
||||
(require racket/list
|
||||
racket/string
|
||||
"device.rkt"
|
||||
"query.rkt"
|
||||
"service.rkt"
|
||||
"services/av-transport.rkt"
|
||||
"services/rendering-control.rkt")
|
||||
|
||||
(provide query-media-renderers
|
||||
media-renderer?
|
||||
media-renderer-name
|
||||
media-renderer-address
|
||||
media-renderer-manufacturer
|
||||
media-renderer-model
|
||||
get-media-renderer
|
||||
media-renderer-dlna?
|
||||
media-renderer-play-uri!
|
||||
media-renderer-next-uri-supported?
|
||||
media-renderer-set-next-uri!
|
||||
media-renderer-pause!
|
||||
media-renderer-stop!
|
||||
media-renderer-seek!
|
||||
media-renderer-status
|
||||
media-renderer-position
|
||||
media-renderer-volume
|
||||
media-renderer-set-volume!
|
||||
media-renderer-muted?
|
||||
media-renderer-set-muted!
|
||||
transport-position?
|
||||
transport-position-track
|
||||
transport-position-seconds
|
||||
transport-position-duration
|
||||
transport-position-uri)
|
||||
|
||||
|
||||
|
||||
(define (get-media-renderer filter-name)
|
||||
(let ((fnm (string-downcase (string-trim filter-name))))
|
||||
(let ((ms (filter (λ (x)
|
||||
(let ((nm (string-downcase (media-renderer-name x))))
|
||||
;(displayln (format "string-contains? '~a' '~a' = ~a" nm fnm (string-contains? nm fnm)))
|
||||
(string-contains? nm fnm)))
|
||||
(query-media-renderers))))
|
||||
(if (null? ms)
|
||||
#f
|
||||
(car ms)))))
|
||||
|
||||
(define (media-renderer? value)
|
||||
(and (upnp-device? value)
|
||||
(eq? (upnp-device-kind value) 'media-renderer)))
|
||||
|
||||
(define (media-renderer-name v)
|
||||
(and (media-renderer? v) (upnp-device-name v)))
|
||||
|
||||
(define (media-renderer-address v)
|
||||
(and (media-renderer? v) (upnp-device-address v)))
|
||||
|
||||
(define (media-renderer-manufacturer v)
|
||||
(and (media-renderer? v) (upnp-device-manufacturer v)))
|
||||
|
||||
(define (media-renderer-model v)
|
||||
(and (media-renderer? v) (upnp-device-model v)))
|
||||
|
||||
(define (media-renderer-dlna? value)
|
||||
(unless (media-renderer? value)
|
||||
(raise-argument-error 'media-renderer-dlna? "media-renderer?" value))
|
||||
(and (upnp-device-property value 'x_dlnadoc #f) #t))
|
||||
|
||||
(define (check-media-renderer who value)
|
||||
(unless (media-renderer? value)
|
||||
(raise-argument-error who "media-renderer?" value)))
|
||||
|
||||
(define (required-service who renderer kind)
|
||||
(check-media-renderer who renderer)
|
||||
(let ([service (upnp-device-service renderer kind)])
|
||||
(unless service
|
||||
(raise-arguments-error
|
||||
who
|
||||
"media renderer does not provide the required UPnP service"
|
||||
"renderer" (upnp-device-name renderer)
|
||||
"service" kind))
|
||||
service))
|
||||
|
||||
(define (query-media-renderers #:interface [interface #f]
|
||||
#:dns? [dns? #f]
|
||||
#:dlna-only? [dlna-only? #f])
|
||||
(unless (boolean? dlna-only?)
|
||||
(raise-argument-error 'query-media-renderers "boolean?" dlna-only?))
|
||||
(let ([renderers
|
||||
(query-upnp-devices 'media-renderer
|
||||
#:interface interface
|
||||
#:dns? dns?)])
|
||||
(if dlna-only?
|
||||
(filter media-renderer-dlna? renderers)
|
||||
renderers)))
|
||||
|
||||
;; Return whether the renderer advertises SetNextAVTransportURI. Reading the
|
||||
;; service description is cached by the generic service layer.
|
||||
(define (media-renderer-next-uri-supported? renderer)
|
||||
(upnp-service-supports-action?
|
||||
(required-service 'media-renderer-next-uri-supported?
|
||||
renderer
|
||||
'av-transport)
|
||||
"SetNextAVTransportURI"))
|
||||
|
||||
;; Set the resource that should play after the current resource. Supporting
|
||||
;; renderers can prefetch this URI and may therefore make the transition
|
||||
;; seamless.
|
||||
(define (media-renderer-set-next-uri! renderer uri #:metadata [metadata ""])
|
||||
(let ([transport (required-service 'media-renderer-set-next-uri!
|
||||
renderer
|
||||
'av-transport)])
|
||||
(unless (upnp-service-supports-action? transport "SetNextAVTransportURI")
|
||||
(raise-arguments-error
|
||||
'media-renderer-set-next-uri!
|
||||
"media renderer does not support preloading a next URI"
|
||||
"renderer" (upnp-device-name renderer)))
|
||||
(av-transport-set-next-uri! transport uri #:metadata metadata)))
|
||||
|
||||
;; Start a resource and optionally preload the following resource before
|
||||
;; playback starts. Setting the next URI first gives the renderer the maximum
|
||||
;; amount of time to buffer it.
|
||||
(define (media-renderer-play-uri! renderer uri
|
||||
#:metadata [metadata ""]
|
||||
#:next-uri [next-uri #f]
|
||||
#:next-metadata [next-metadata ""])
|
||||
(unless (or (not next-uri) (string? next-uri))
|
||||
(raise-argument-error 'media-renderer-play-uri!
|
||||
"(or/c #f string?)"
|
||||
next-uri))
|
||||
(let ([transport (required-service 'media-renderer-play-uri!
|
||||
renderer
|
||||
'av-transport)])
|
||||
(av-transport-set-uri! transport uri #:metadata metadata)
|
||||
(when next-uri
|
||||
(unless (upnp-service-supports-action? transport "SetNextAVTransportURI")
|
||||
(raise-arguments-error
|
||||
'media-renderer-play-uri!
|
||||
"media renderer does not support preloading a next URI"
|
||||
"renderer" (upnp-device-name renderer)))
|
||||
(av-transport-set-next-uri! transport
|
||||
next-uri
|
||||
#:metadata next-metadata))
|
||||
(av-transport-play! transport)))
|
||||
|
||||
(define (media-renderer-pause! renderer)
|
||||
(av-transport-pause!
|
||||
(required-service 'media-renderer-pause! renderer 'av-transport)))
|
||||
|
||||
(define (media-renderer-stop! renderer)
|
||||
(av-transport-stop!
|
||||
(required-service 'media-renderer-stop! renderer 'av-transport)))
|
||||
|
||||
(define (media-renderer-seek! renderer seconds)
|
||||
(av-transport-seek!
|
||||
(required-service 'media-renderer-seek! renderer 'av-transport)
|
||||
seconds))
|
||||
|
||||
(define (media-renderer-status renderer)
|
||||
(av-transport-status
|
||||
(required-service 'media-renderer-status renderer 'av-transport)))
|
||||
|
||||
(define (media-renderer-position renderer)
|
||||
(av-transport-position
|
||||
(required-service 'media-renderer-position renderer 'av-transport)))
|
||||
|
||||
(define (media-renderer-volume renderer)
|
||||
(rendering-control-volume
|
||||
(required-service 'media-renderer-volume renderer 'rendering-control)))
|
||||
|
||||
(define (media-renderer-set-volume! renderer volume)
|
||||
(rendering-control-set-volume!
|
||||
(required-service 'media-renderer-set-volume!
|
||||
renderer
|
||||
'rendering-control)
|
||||
volume))
|
||||
|
||||
(define (media-renderer-muted? renderer)
|
||||
(rendering-control-muted?
|
||||
(required-service 'media-renderer-muted? renderer 'rendering-control)))
|
||||
|
||||
(define (media-renderer-set-muted! renderer muted?)
|
||||
(rendering-control-set-muted!
|
||||
(required-service 'media-renderer-set-muted!
|
||||
renderer
|
||||
'rendering-control)
|
||||
muted?))
|
||||
Reference in New Issue
Block a user