#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))))