189 lines
6.4 KiB
Racket
189 lines
6.4 KiB
Racket
#lang racket/base
|
|
|
|
;; Typed interface for the UPnP AVTransport service.
|
|
|
|
(require racket/format
|
|
racket/string
|
|
"../service.rkt")
|
|
|
|
(provide av-transport?
|
|
device-av-transport
|
|
av-transport-set-uri!
|
|
av-transport-set-next-uri!
|
|
av-transport-play!
|
|
av-transport-pause!
|
|
av-transport-stop!
|
|
av-transport-seek!
|
|
av-transport-status
|
|
av-transport-position
|
|
transport-position?
|
|
transport-position-track
|
|
transport-position-seconds
|
|
transport-position-duration
|
|
transport-position-uri)
|
|
|
|
(struct transport-position
|
|
(track seconds duration uri)
|
|
#:transparent
|
|
#:constructor-name make-transport-position)
|
|
|
|
(define (av-transport? value)
|
|
(and (upnp-service? value)
|
|
(eq? (upnp-service-kind value) 'av-transport)))
|
|
|
|
(define (check-av-transport who value)
|
|
(unless (av-transport? value)
|
|
(raise-argument-error who "av-transport?" value)))
|
|
|
|
(define (device-av-transport device)
|
|
(upnp-device-service device 'av-transport))
|
|
|
|
(define (result-ref result name [default #f])
|
|
(hash-ref result name default))
|
|
|
|
(define (seconds->upnp-time seconds)
|
|
(unless (and (real? seconds) (not (negative? seconds)))
|
|
(raise-argument-error 'av-transport-seek!
|
|
"nonnegative-real?"
|
|
seconds))
|
|
(let* ([total (inexact->exact (floor seconds))]
|
|
[hours (quotient total 3600)]
|
|
[remaining (remainder total 3600)]
|
|
[minutes (quotient remaining 60)]
|
|
[secs (remainder remaining 60)])
|
|
(format "~a:~a:~a"
|
|
(~r hours #:min-width 2 #:pad-string "0")
|
|
(~r minutes #:min-width 2 #:pad-string "0")
|
|
(~r secs #:min-width 2 #:pad-string "0"))))
|
|
|
|
(define (upnp-time->seconds value)
|
|
(if (or (not value)
|
|
(string-ci=? value "NOT_IMPLEMENTED"))
|
|
#f
|
|
(let ([match
|
|
(regexp-match
|
|
#px"^([0-9]+):([0-9]{2}):([0-9]{2})(?:\\.([0-9]+))?$"
|
|
value)])
|
|
(and match
|
|
(let* ([hours (string->number (cadr match))]
|
|
[minutes (string->number (caddr match))]
|
|
[seconds (string->number (cadddr match))]
|
|
[fraction-text (list-ref match 4)]
|
|
[fraction
|
|
(if fraction-text
|
|
(/ (string->number fraction-text)
|
|
(expt 10 (string-length fraction-text)))
|
|
0)])
|
|
(+ (* hours 3600) (* minutes 60) seconds fraction))))))
|
|
|
|
(define (transport-state->symbol value)
|
|
(cond
|
|
[(not value) 'unknown]
|
|
[(string-ci=? value "PLAYING") 'playing]
|
|
[(string-ci=? value "PAUSED_PLAYBACK") 'paused]
|
|
[(string-ci=? value "PAUSED_RECORDING") 'paused]
|
|
[(string-ci=? value "STOPPED") 'stopped]
|
|
[(string-ci=? value "TRANSITIONING") 'transitioning]
|
|
[(string-ci=? value "NO_MEDIA_PRESENT") 'no-media]
|
|
[(string-ci=? value "RECORDING") 'recording]
|
|
[else 'unknown]))
|
|
|
|
(define (av-transport-set-uri! transport uri
|
|
#:metadata [metadata ""]
|
|
#:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-set-uri! transport)
|
|
(unless (string? uri)
|
|
(raise-argument-error 'av-transport-set-uri! "string?" uri))
|
|
(unless (string? metadata)
|
|
(raise-argument-error 'av-transport-set-uri! "string?" metadata))
|
|
(upnp-service-call
|
|
transport
|
|
"SetAVTransportURI"
|
|
(list (cons "InstanceID" instance-id)
|
|
(cons "CurrentURI" uri)
|
|
(cons "CurrentURIMetaData" metadata)))
|
|
(void))
|
|
|
|
;; Set the resource that should follow the current AVTransport URI.
|
|
;;
|
|
;; SetNextAVTransportURI is optional. Call
|
|
;; upnp-service-supports-action? when the caller needs to test support before
|
|
;; attempting the operation. A supporting renderer may prefetch the resource
|
|
;; to provide a seamless transition.
|
|
(define (av-transport-set-next-uri! transport uri
|
|
#:metadata [metadata ""]
|
|
#:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-set-next-uri! transport)
|
|
(unless (string? uri)
|
|
(raise-argument-error 'av-transport-set-next-uri! "string?" uri))
|
|
(unless (string? metadata)
|
|
(raise-argument-error 'av-transport-set-next-uri! "string?" metadata))
|
|
(upnp-service-call
|
|
transport
|
|
"SetNextAVTransportURI"
|
|
(list (cons "InstanceID" instance-id)
|
|
(cons "NextURI" uri)
|
|
(cons "NextURIMetaData" metadata)))
|
|
(void))
|
|
|
|
(define (av-transport-play! transport
|
|
#:speed [speed 1]
|
|
#:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-play! transport)
|
|
(upnp-service-call
|
|
transport
|
|
"Play"
|
|
(list (cons "InstanceID" instance-id)
|
|
(cons "Speed" speed)))
|
|
(void))
|
|
|
|
(define (av-transport-pause! transport #:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-pause! transport)
|
|
(upnp-service-call
|
|
transport
|
|
"Pause"
|
|
(list (cons "InstanceID" instance-id)))
|
|
(void))
|
|
|
|
(define (av-transport-stop! transport #:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-stop! transport)
|
|
(upnp-service-call
|
|
transport
|
|
"Stop"
|
|
(list (cons "InstanceID" instance-id)))
|
|
(void))
|
|
|
|
(define (av-transport-seek! transport seconds #:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-seek! transport)
|
|
(upnp-service-call
|
|
transport
|
|
"Seek"
|
|
(list (cons "InstanceID" instance-id)
|
|
(cons "Unit" "REL_TIME")
|
|
(cons "Target" (seconds->upnp-time seconds))))
|
|
(void))
|
|
|
|
(define (av-transport-status transport #:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-status transport)
|
|
(let ([result
|
|
(upnp-service-call
|
|
transport
|
|
"GetTransportInfo"
|
|
(list (cons "InstanceID" instance-id)))])
|
|
(transport-state->symbol
|
|
(result-ref result "CurrentTransportState" #f))))
|
|
|
|
(define (av-transport-position transport #:instance-id [instance-id 0])
|
|
(check-av-transport 'av-transport-position transport)
|
|
(let ([result
|
|
(upnp-service-call
|
|
transport
|
|
"GetPositionInfo"
|
|
(list (cons "InstanceID" instance-id)))])
|
|
(make-transport-position
|
|
(let ([track (result-ref result "Track" #f)])
|
|
(and track (string->number track)))
|
|
(upnp-time->seconds (result-ref result "RelTime" #f))
|
|
(upnp-time->seconds (result-ref result "TrackDuration" #f))
|
|
(result-ref result "TrackURI" #f))))
|