196 lines
7.1 KiB
Racket
196 lines
7.1 KiB
Racket
#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?))
|