#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-play! 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-play! renderer) (av-transport-play! (required-service 'media-renderer-play! 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?))