114 lines
3.2 KiB
Racket
114 lines
3.2 KiB
Racket
#lang racket
|
|
|
|
(require racket/class
|
|
racket/list
|
|
racket-sonos
|
|
racket-upnp
|
|
"renderer-sonos.rkt"
|
|
"renderer-upnp.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide check-dlna-players)
|
|
|
|
(define running-sem (make-semaphore 1))
|
|
(define running #f)
|
|
|
|
(define (normalized-device-id device)
|
|
(let ((id (upnp-device-udn device)))
|
|
(and id
|
|
(let ((match
|
|
(regexp-match
|
|
#px"(?i:RINCON_[0-9A-F]+)"
|
|
id)))
|
|
(if match
|
|
(string-upcase
|
|
(car match))
|
|
(regexp-replace
|
|
#px"(?i:^uuid:)"
|
|
id
|
|
""))))))
|
|
|
|
(define (represented-by-sonos-group? device member-ids)
|
|
(let ((id (normalized-device-id device)))
|
|
(and id
|
|
(ormap
|
|
(lambda (member-id)
|
|
(string-ci=? id member-id))
|
|
member-ids))))
|
|
|
|
(define (make-generic-renderers devices preferences
|
|
#:excluded-ids [excluded-ids '()])
|
|
(for/list ((device
|
|
(in-list
|
|
(filter media-renderer? devices)))
|
|
#:unless
|
|
(represented-by-sonos-group?
|
|
device
|
|
excluded-ids))
|
|
(new renderer-upnp%
|
|
[upnp-device device]
|
|
[name
|
|
(if (sonos-device? device)
|
|
(sonos-device-name device)
|
|
#f)]
|
|
[preferences preferences])))
|
|
|
|
(define (discover-renderers preferences)
|
|
(let* ((devices (query-upnp-devices 'all))
|
|
(groups
|
|
(with-handlers
|
|
((exn:fail?
|
|
(lambda (e)
|
|
(warn-rktplayer
|
|
"Could not read Sonos topology; using generic UPnP renderers: ~a"
|
|
(exn-message e))
|
|
'())))
|
|
(sonos-groups devices)))
|
|
(renderers
|
|
(if (null? groups)
|
|
(make-generic-renderers
|
|
devices
|
|
preferences)
|
|
(append
|
|
(make-generic-renderers
|
|
devices
|
|
preferences
|
|
#:excluded-ids
|
|
(append-map
|
|
sonos-group-member-ids
|
|
groups))
|
|
(for/list ((group (in-list groups)))
|
|
(new renderer-sonos%
|
|
[sonos-group group]
|
|
[preferences preferences]))))))
|
|
(sort renderers
|
|
string-ci<?
|
|
#:key
|
|
(lambda (renderer)
|
|
(send renderer get-name)))))
|
|
|
|
(define (check-dlna-players gui preferences)
|
|
(let ((can-check
|
|
(begin
|
|
(semaphore-wait running-sem)
|
|
(let ((was-running running))
|
|
(unless was-running
|
|
(set! running #t))
|
|
(semaphore-post running-sem)
|
|
(not was-running)))))
|
|
(if can-check
|
|
(void
|
|
(thread
|
|
(lambda ()
|
|
(dynamic-wind
|
|
void
|
|
(lambda ()
|
|
(send gui
|
|
set-dlna-renderers!
|
|
(discover-renderers preferences)))
|
|
(lambda ()
|
|
(semaphore-wait running-sem)
|
|
(set! running #f)
|
|
(semaphore-post running-sem))))))
|
|
(send gui dlna-query-busy))))
|